Session Featherweight_OCL

Theory UML_Types

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Types.thy --- Types definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved. 
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

chapter‹Formalization I: OCL Types and Core Definitions \label{sec:focl-types}›

theory    UML_Types
imports   HOL.Transcendental
keywords "Assert" :: thy_decl
     and "Assert_local" :: thy_decl
begin

section‹Preliminaries›
subsection‹Notations for the Option Type›

text‹
  First of all, we will use a more compact notation for the library
  option type which occur all over in our definitions and which will make
  the presentation more like a textbook:
›

no_notation ceiling  ("_") (* For Real Numbers only ... Otherwise has unfortunate side-effects on syntax. *)
no_notation floor  ("_") (* For Real Numbers only ... Otherwise has unfortunate side-effects on syntax. *)

type_notation option ("_") (* NOTE: "_" also works *)
notation Some ("(_)")
notation None ("")

text‹These commands introduce an alternative, more compact notation for the type constructor
 @{typ " option"}, namely @{typ ""}. Furthermore, the constructors @{term "Some X"} and 
 @{term "None"} of the type @{typ " option"}, namely @{term "X"} and @{term ""}.›

text‹
  The following function (corresponding to @{term the} in the Isabelle/HOL library)
  is defined as the inverse of the injection @{term Some}.
›
fun    drop :: " option  " ("(_)")
where  drop_lift[simp]: "v = v"

text‹The definitions for the constants and operations based on functions
will be geared towards a format that Isabelle can check to be a ``conservative''
(\ie, logically safe) axiomatic definition. By introducing an explicit
interpretation function (which happens to be defined just as the identity
since we are using a shallow embedding of OCL into HOL), all these definitions
can be rewritten into the conventional semantic textbook format.
To say it in other words: The interpretation function Sem› as defined
below is just a textual marker for presentation purposes, i.e. intended for readers
used to conventional textbook notations on semantics. Since we use a ``shallow embedding'',
i.e. since we represent the syntax of OCL directly by HOL constants, the interpretation function
is semantically not only superfluous, but from an Isabelle perspective strictly in
the way for certain consistency checks performed by the definitional packages.
›

definition Sem :: "'a  'a" ("I⟦_")
where "I⟦x  x"


subsection‹Common Infrastructure for all OCL Types \label{sec:focl-common-types}›

text ‹In order to have the possibility to nest collection types,
  such that we can give semantics to expressions like Set{Set{𝟮},null}›,
  it is necessary to introduce a uniform interface for types having
  the invalid› (= bottom) element. The reason is that we impose
  a data-invariant on raw-collection \inlineisar|types_code| which assures
  that the invalid› element is not allowed inside the collection;
  all raw-collections of this form were identified with the invalid› element
  itself. The construction requires that the new collection type is
  not comparable with the raw-types (consisting of nested option type constructions),
  such that the data-invariant must be expressed in terms of the interface.
  In a second step, our base-types will be shown to be instances of this interface.
›

text‹
  This uniform interface consists in a type class requiring the existence
  of a bot and a null element. The construction proceeds by
  abstracting the null (defined by ⌊ ⊥ ⌋› on
  'a option option›) to a null› element, which may
  have an arbitrary semantic structure, and an undefinedness element ⊥›
  to an abstract undefinedness element bot› (also written
  ⊥› whenever no confusion arises). As a consequence, it is necessary
  to redefine the notions of invalid, defined, valuation etc.
  on top of this interface.›

text‹
  This interface consists in two abstract type classes bot›
  and null› for the class of all types comprising a bot and a
  distinct null element.›

class   bot =
   fixes   bot :: "'a"
   assumes nonEmpty : " x. x  bot"


class      null = bot +
   fixes   null :: "'a"
   assumes null_is_valid : "null  bot"


subsection‹Accommodation of Basic Types to the Abstract Interface›

text‹
  In the following it is shown that the ``option-option'' type is
  in fact in the null› class and that function spaces over these
  classes again ``live'' in these classes. This motivates the default construction
  of the semantic domain for the basic types (\inlineocl{Boolean},
  \inlineocl{Integer}, \inlineocl{Real}, \ldots).
›

instantiation   option  :: (type)bot
begin
   definition bot_option_def: "(bot::'a option)  (None::'a option)"
   instance proof show        "x::'a option. x  bot"
                  by(rule_tac x="Some x" in exI, simp add:bot_option_def)
            qed
end


instantiation   option  :: (bot)null
begin
   definition null_option_def: "(null::'a::bot option)    bot "
   instance proof  show        "(null::'a::bot option)  bot"
                   by( simp add : null_option_def bot_option_def)
            qed
end


instantiation "fun"  :: (type,bot) bot
begin
   definition bot_fun_def: "bot  (λ x. bot)"
   instance proof  show "(x::'a  'b). x  bot"
                   apply(rule_tac x="λ _. (SOME y. y  bot)" in exI, auto)
                   apply(drule_tac x=x in fun_cong,auto simp:bot_fun_def)
                   apply(erule contrapos_pp, simp)
                   apply(rule some_eq_ex[THEN iffD2])
                   apply(simp add: nonEmpty)
                   done
            qed
end


instantiation "fun"  :: (type,null) null
begin
 definition null_fun_def: "(null::'a  'b::null)  (λ x. null)"
 instance proof
              show "(null::'a  'b::null)  bot"
              apply(auto simp: null_fun_def bot_fun_def)
              apply(drule_tac x=x in fun_cong)
              apply(erule contrapos_pp, simp add: null_is_valid)
            done
          qed
end

text‹A trivial consequence of this adaption of the interface is that
abstract and concrete versions of null are the same on base types
(as could be expected).›

subsection‹The Common Infrastructure of Object Types (Class Types) and States.›

text‹Recall that OCL is a textual extension of the UML; in particular, we use OCL as means to 
annotate UML class models. Thus, OCL inherits a notion of \emph{data} in the UML: UML class
models provide classes, inheritance, types of objects, and subtypes connecting them along
the inheritance hierarchie.
›

text‹For the moment, we formalize the most common notions of objects, in particular
the existance of object-identifiers (oid) for each object under which it can
be referenced in a \emph{state}.›

type_synonym oid = nat

text‹We refrained from the alternative:
\begin{isar}[mathescape]
$\text{\textbf{type-synonym}}$ $\mathit{oid = ind}$
\end{isar}
which is slightly more abstract but non-executable.
›

text‹\emph{States} in UML/OCL are a pair of
\begin{itemize}
\item a partial map from oid's to elements of an \emph{object universe},
      \ie{} the set of all possible object representations.
\item and an oid-indexed family of \emph{associations}, \ie{} finite relations between
      objects living in a state. These relations can be n-ary which we model by nested lists.
\end{itemize}      
For the moment we do not have to describe the concrete structure of the object universe and denote 
it by the  polymorphic variable '𝔄›.›

record ('𝔄)state =
             heap   :: "oid  '𝔄 "
             assocs :: "oid  ((oid list) list) list"

text‹In general, OCL operations are functions implicitly depending on a pair
of pre- and post-state, \ie{} \emph{state transitions}. Since this will be reflected in our 
representation of OCL Types within HOL, we need to introduce the foundational concept of an 
object id (oid), which is just some infinite set, and some abstract notion of state.›

type_synonym ('𝔄)st = "'𝔄 state × '𝔄 state"

text‹We will require for all objects that there is a function that
projects the oid of an object in the state (we will settle the question how to define
this function later). We will use the Isabelle type class mechanism~\cite{haftmann.ea:constructive:2006} 
to capture this:›

class object =  fixes oid_of :: "'a  oid"

text‹Thus, if needed, we can constrain the object universe to objects by adding
the following type class constraint:›
typ "'𝔄 :: object"

text‹The major instance needed are instances constructed over options: once an object,
options of objects are also objects.›
instantiation   option  :: (object)object
begin
   definition oid_of_option_def: "oid_of x = oid_of (the x)"
   instance ..
end


subsection‹Common Infrastructure for all OCL Types (II): Valuations as OCL Types›
text‹Since OCL operations in general depend on pre- and post-states, we will
represent OCL types as \emph{functions} from pre- and post-state to some
HOL raw-type that contains exactly the data in the OCL type --- see below. 
This gives rise to the idea that we represent OCL types by \emph{Valuations}.
›
text‹Valuations are functions from a state pair (built upon
data universe @{typ "'𝔄"}) to an arbitrary null-type (\ie, containing
at least a destinguished null› and invalid› element).›

type_synonym ('𝔄,) val = "'𝔄 st  ::null"

text‹The definitions for the constants and operations based on valuations
will be geared towards a format that Isabelle can check to be a ``conservative''
(\ie, logically safe) axiomatic definition. By introducing an explicit
interpretation function (which happens to be defined just as the identity
since we are using a shallow embedding of OCL into HOL), all these definitions
can be rewritten into the conventional semantic textbook format  as follows:›

subsection‹The fundamental constants 'invalid' and 'null' in all OCL Types›

text‹As a consequence of semantic domain definition, any OCL type will
have the two semantic constants invalid› (for exceptional, aborted
computation) and null›:
›

definition invalid :: "('𝔄,::bot) val"
where     "invalid  λ τ. bot"

text‹This conservative Isabelle definition of the polymorphic constant
@{const invalid} is equivalent with the textbook definition:›

lemma textbook_invalid: "I⟦invalidτ = bot"
by(simp add: invalid_def Sem_def)


text ‹Note that the definition :
{\small
\begin{isar}[mathescape]
definition null    :: "('$\mathfrak{A}$,'α::null) val"
where     "null    ≡ λ τ. null"
\end{isar}
} is not  necessary since we defined the entire function space over null types
again as null-types; the crucial definition is @{thm "null_fun_def"}.
Thus, the polymorphic constant @{const null} is simply the result of
a general type class construction. Nevertheless, we can derive the
semantic textbook definition for the OCL null constant based on the
abstract null:
›

lemma textbook_null_fun: "I⟦null::('𝔄,::null) val τ = (null::(::null))"
by(simp add: null_fun_def Sem_def)

section‹Basic OCL Value Types›

text ‹The structure of this section roughly follows the structure of Chapter
11 of the OCL standard~\cite{omg:ocl:2012}, which introduces the OCL
Library.›

text‹The semantic domain of the (basic) boolean type is now defined as the Standard:
the space of valuation to @{typ "bool option option"}, \ie{} the Boolean base type:›

type_synonym Booleanbase  = "bool option option"
type_synonym ('𝔄)Boolean = "('𝔄,Booleanbase) val"

text‹Because of the previous class definitions, Isabelle type-inference establishes that
@{typ "('𝔄)Boolean"} lives actually both in the type class @{term bot} and @{term null};
this type is sufficiently rich to contain at least these two elements.
Analogously we build:›
type_synonym Integerbase  = "int option option"
type_synonym ('𝔄)Integer = "('𝔄,Integerbase) val"

type_synonym Stringbase  = "string option option"
type_synonym ('𝔄)String = "('𝔄,Stringbase) val"

type_synonym Realbase = "real option option"
type_synonym ('𝔄)Real = "('𝔄,Realbase) val"

text‹Since @{term "Real"} is again a basic type, we define its semantic domain
as the valuations over real option option› --- i.e. the mathematical type of real numbers.
The HOL-theory for real› ``Real'' transcendental numbers such as $\pi$ and $e$ as well as
infrastructure to reason over infinite convergent Cauchy-sequences (it is thus possible, in principle,
to reason in Featherweight OCL that the sum of inverted two-s exponentials is actually 2.

If needed, a code-generator to compile Real› to floating-point
numbers can be added; this allows for mapping reals to an efficient machine representation;
of course, this feature would be logically unsafe.›

text‹For technical reasons related to the Isabelle type inference for type-classes
(we don't get the properties in the right order that class instantiation provides them,
if we would follow the previous scheme), we give a slightly atypic definition:›

typedef Voidbase = "{X::unit option option. X = bot  X = null }" by(rule_tac x="bot" in exI, simp)

type_synonym ('𝔄)Void = "('𝔄,Voidbase) val"




section‹Some OCL Collection Types›

text‹For the semantic construction of the collection types, we have two goals:
\begin{enumerate}
\item we want the types to be \emph{fully abstract}, \ie, the type should not
      contain junk-elements that are not representable by OCL expressions, and
\item we want a possibility to nest collection types (so, we want the
      potential of talking about Set(Set(Sequences(Pairs(X,Y))))›).
\end{enumerate}
The former principle rules out the option to define 'α Set› just by
 ('𝔄, ('α option option) set) val›. This would allow sets to contain
junk elements such as {⊥}› which we need to identify with undefinedness
itself. Abandoning fully abstractness of rules would later on produce all sorts
of problems when quantifying over the elements of a type.
However, if we build an own type, then it must conform to our abstract interface
in order to have nested types: arguments of type-constructors must conform to our
abstract interface, and the result type too.
›

subsection‹The Construction of the Pair Type (Tuples)›

text‹The core of an own type construction is done via a type
  definition which provides the base-type ('α, 'β) Pairbase. It
  is shown that this type ``fits'' indeed into the abstract type
  interface discussed in the previous section.›

typedef (overloaded) (, ) Pairbase = "{X::(::null × ::null) option option.
                                           X = bot  X = null  (fstX  bot  sndX  bot)}"
                            by (rule_tac x="bot" in exI, simp)

text‹We ``carve'' out from the concrete type @{typ "(::null × ::null) option option"} 
the new fully abstract type, which will not contain representations like @{term "(,a)"}
or @{term "(b,)"}. The type constuctor Pair{x,y}› to be defined later will
identify these with @{term "invalid"}.
›

instantiation   Pairbase  :: (null,null)bot
begin
   definition bot_Pairbase_def: "(bot_class.bot :: ('a::null,'b::null) Pairbase)  Abs_Pairbase None"

   instance proof show "x::('a,'b) Pairbase. x  bot"
                  apply(rule_tac x="Abs_Pairbase None" in exI)
                  by(simp add: bot_Pairbase_def  Abs_Pairbase_inject  null_option_def bot_option_def)
            qed
end

instantiation   Pairbase  :: (null,null)null
begin
   definition null_Pairbase_def: "(null::('a::null,'b::null) Pairbase)  Abs_Pairbase  None "

   instance proof show "(null::('a::null,'b::null) Pairbase)  bot"
                  by(simp add: bot_Pairbase_def null_Pairbase_def Abs_Pairbase_inject 
                               null_option_def bot_option_def)
            qed
end


text‹...  and lifting this type to the format of a valuation gives us:›
type_synonym    ('𝔄,,) Pair  = "('𝔄, (,) Pairbase) val"
type_notation   Pairbase ("Pair'(_,_')")

subsection‹The Construction of the Set Type›

text‹The core of an own type construction is done via a type
  definition which provides the raw-type 'α Setbase. It
  is shown that this type ``fits'' indeed into the abstract type
  interface discussed in the previous section. Note that we make 
  no restriction whatsoever to \emph{finite} sets; while with 
  the standards type-constructors only finite sets can be denoted,
  there is the possibility to define in fact infinite 
  type constructors in \FOCL (c.f. \autoref{sec:type-extensions}).›

typedef (overloaded)  Setbase ="{X::(::null) set option option. X = bot  X = null  (xX. x  bot)}"
          by (rule_tac x="bot" in exI, simp)

instantiation   Setbase  :: (null)bot
begin

   definition bot_Setbase_def: "(bot::('a::null) Setbase)  Abs_Setbase None"

   instance proof show "x::'a Setbase. x  bot"
                  apply(rule_tac x="Abs_Setbase None" in exI)
                  by(simp add: bot_Setbase_def Abs_Setbase_inject null_option_def bot_option_def)
            qed
end

instantiation   Setbase  :: (null)null
begin

   definition null_Setbase_def: "(null::('a::null) Setbase)  Abs_Setbase  None "

   instance proof show "(null::('a::null) Setbase)  bot"
                  by(simp add:null_Setbase_def bot_Setbase_def Abs_Setbase_inject 
                              null_option_def bot_option_def)
            qed
end

text‹...  and lifting this type to the format of a valuation gives us:›
type_synonym    ('𝔄,) Set  = "('𝔄,  Setbase) val"
type_notation   Setbase ("Set'(_')")

subsection‹The Construction of the Bag Type›
text‹The core of an own type construction is done via a type
  definition which provides the raw-type 'α Bagbase
  based on multi-sets from the \HOL library. As in Sets, it
  is shown that this type ``fits'' indeed into the abstract type
  interface discussed in the previous section, and as in sets, we make 
  no restriction whatsoever to \emph{finite} multi-sets; while with 
  the standards type-constructors only finite sets can be denoted,
  there is the possibility to define in fact infinite 
  type constructors in \FOCL (c.f. \autoref{sec:type-extensions}). 
  However, while several null› elements are possible in a Bag, there
  can't be no bottom (invalid) element in them.
›

typedef (overloaded)  Bagbase ="{X::(::null  nat) option option. X = bot  X = null  X bot = 0 }"
          by (rule_tac x="bot" in exI, simp)

instantiation   Bagbase  :: (null)bot
begin

   definition bot_Bagbase_def: "(bot::('a::null) Bagbase)  Abs_Bagbase None"

   instance proof show "x::'a Bagbase. x  bot"
                  apply(rule_tac x="Abs_Bagbase None" in exI)
                  by(simp add: bot_Bagbase_def Abs_Bagbase_inject 
                               null_option_def bot_option_def)
            qed
end

instantiation   Bagbase  :: (null)null
begin

   definition null_Bagbase_def: "(null::('a::null) Bagbase)  Abs_Bagbase  None "

   instance proof show "(null::('a::null) Bagbase)  bot"
                  by(simp add:null_Bagbase_def bot_Bagbase_def Abs_Bagbase_inject 
                              null_option_def bot_option_def)
            qed
end

text‹...  and lifting this type to the format of a valuation gives us:›
type_synonym    ('𝔄,) Bag  = "('𝔄,  Bagbase) val"
type_notation   Bagbase ("Bag'(_')")

subsection‹The Construction of the Sequence Type›

text‹The core of an own type construction is done via a type
  definition which provides the base-type 'α Sequencebase. It
  is shown that this type ``fits'' indeed into the abstract type
  interface discussed in the previous section.›

typedef (overloaded)  Sequencebase ="{X::(::null) list option option.
                                        X = bot  X = null  (xset X. x  bot)}"
          by (rule_tac x="bot" in exI, simp)

instantiation   Sequencebase  :: (null)bot
begin

   definition bot_Sequencebase_def: "(bot::('a::null) Sequencebase)  Abs_Sequencebase None"

   instance proof show "x::'a Sequencebase. x  bot"
                  apply(rule_tac x="Abs_Sequencebase None" in exI)
                  by(auto simp:bot_Sequencebase_def Abs_Sequencebase_inject 
                               null_option_def bot_option_def)
            qed
end


instantiation   Sequencebase  :: (null)null
begin

   definition null_Sequencebase_def: "(null::('a::null) Sequencebase)  Abs_Sequencebase  None "

   instance proof show "(null::('a::null) Sequencebase)  bot"
                  by(auto simp:bot_Sequencebase_def null_Sequencebase_def Abs_Sequencebase_inject 
                               null_option_def bot_option_def)
            qed
end


text‹...  and lifting this type to the format of a valuation gives us:›
type_synonym    ('𝔄,) Sequence  = "('𝔄,  Sequencebase) val"
type_notation   Sequencebase ("Sequence'(_')")

subsection‹Discussion: The Representation of UML/OCL Types in Featherweight OCL›
text‹In the introduction, we mentioned that there is an ``injective representation
mapping'' between the types of OCL and the types of Featherweight OCL (and its 
meta-language: HOL). This injectivity is at the heart of our representation technique
--- a so-called \emph{shallow embedding} --- and means: OCL types were mapped one-to-one
to types in HOL, ruling out a resentation where
everything is mapped on some common HOL-type, say ``OCL-expression'', in which we 
would have to sort out the typing of OCL and its impact on the semantic representation
function in an own, quite heavy side-calculus.
›

text‹After the previous sections, we are now able to exemplify this representation as follows:

\begin{table}[htbp]
   \centering
   \begin{tabu}{lX[,c,]}
      \toprule
      OCL Type & HOL Type \\
      \midrule 
      \inlineocl|Boolean|  & @{typ  "('𝔄)Boolean"} \\
      \inlineocl|Boolean -> Boolean| & @{typ  "('𝔄)Boolean  ('𝔄)Boolean"} \\
      \inlineocl|(Integer,Integer) -> Boolean| & @{typ  "('𝔄)Integer  ('𝔄)Integer  ('𝔄)Boolean"} \\
      \inlineocl|Set(Integer)| & @{typ "('𝔄,Integerbase)Set"} \\
      \inlineocl|Set(Integer)-> Real| & @{typ "('𝔄,Integerbase)Set  ('𝔄)Real"} \\
      \inlineocl|Set(Pair(Integer,Boolean))| & @{typ "('𝔄,(Integerbase, Booleanbase)Pairbase)Set"} \\
      \inlineocl|Set(<T>)| & @{typ "('𝔄,::null)Set"} \\
      \bottomrule
   \end{tabu}
   \caption{Correspondance between \OCL types and \HOL types}
   \label{tab:types}
\end{table}
We do not formalize the representation map here; however, its principles are quite straight-forward:
\begin{enumerate}
\item cartesion products of arguments were curried,
\item constants of type \inlineocl{T} were mapped to valuations over the
      HOL-type for \inlineocl{T},
\item functions \inlineocl{T -> T'} were mapped to functions in HOL, where
      \inlineocl{T} and  \inlineocl{T'}  were mapped to the valuations for them, and
\item the arguments of type constructors  \inlineocl{Set(T)} remain corresponding HOL base-types.
\end{enumerate}
      
›

text‹Note, furthermore, that our construction of ``fully abstract types'' (no junk, no confusion)
assures that the logical equality to be defined in the next section works correctly and comes
as element of the ``lingua franca'', \ie{} HOL.›

(*<*)
section‹Miscelleaneous: ML assertions›

text‹We introduce here a new command \emph{Assert} similar as \emph{value} for proving
 that the given term in argument is a true proposition. The difference with \emph{value} is that
\emph{Assert} fails if the normal form of the term evaluated is not equal to @{term True}. 
Moreover, in case \emph{value} could not normalize the given term, as another strategy of reduction
 we try to prove it with a single ``simp'' tactic.›

MLfun disp_msg title msg status = title ^ ": '" ^ msg ^ "' " ^ status

fun lemma msg specification_theorem concl in_local thy =
  SOME
    (in_local (fn lthy =>
           specification_theorem Thm.theoremK NONE (K I) Binding.empty_atts [] [] 
             (Element.Shows [(Binding.empty_atts, [(concl lthy, [])])])
             false lthy
        |> Proof.global_terminal_proof
             ((Method.Combinator ( Method.no_combinator_info
                                 , Method.Then
                                 , [Method.Basic (fn ctxt => SIMPLE_METHOD (asm_full_simp_tac ctxt 1))]),
               (Position.none, Position.none)), NONE))
              thy)
  handle ERROR s =>
    (warning s; writeln (disp_msg "KO" msg "failed to normalize"); NONE)

fun outer_syntax_command command_spec theory in_local =
  Outer_Syntax.command command_spec "assert that the given specification is true"
    (Parse.term >> (fn elems_concl => theory (fn thy =>
      case
        lemma "nbe" (Specification.theorem true)
          (fn lthy => 
            let val expr = Nbe.dynamic_value lthy (Syntax.read_term lthy elems_concl)
                val thy = Proof_Context.theory_of lthy
                open HOLogic in
            if Sign.typ_equiv thy (fastype_of expr, @{typ "prop"}) then
              expr
            else mk_Trueprop (mk_eq (@{term "True"}, expr))
            end)
          in_local
          thy
      of  NONE => 
            let val attr_simp = "simp" in
            case lemma attr_simp (Specification.theorem_cmd true) (K elems_concl) in_local thy of
               NONE => raise (ERROR "Assertion failed")
             | SOME thy => 
                (writeln (disp_msg "OK" "simp" "finished the normalization");
                 thy)
            end
        | SOME thy => thy)))

val () = outer_syntax_command @{command_keyword Assert} Toplevel.theory Named_Target.theory_map
val () = outer_syntax_command @{command_keyword Assert_local} (Toplevel.local_theory NONE NONE) I
›
(*>*)


end

Theory UML_Logic

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Logic.thy --- Core definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

chapter‹Formalization II: OCL Terms and Library Operations›

theory  UML_Logic 
imports UML_Types 
begin

section‹The Operations of the Boolean Type and the OCL Logic›

subsection‹Basic Constants›

lemma bot_Boolean_def : "(bot::('𝔄)Boolean) = (λ τ. )"
by(simp add: bot_fun_def bot_option_def)

lemma null_Boolean_def : "(null::('𝔄)Boolean) = (λ τ. )"
by(simp add: null_fun_def null_option_def bot_option_def)

definition true :: "('𝔄)Boolean"
where     "true  λ τ. True"


definition false :: "('𝔄)Boolean"
where     "false   λ τ. False"

lemma bool_split_0: "X τ = invalid τ  X τ = null τ 
                   X τ = true τ     X τ = false τ"
apply(simp add: invalid_def null_def true_def false_def)
apply(case_tac "X τ",simp_all add: null_fun_def null_option_def bot_option_def)
apply(case_tac "a",simp)
apply(case_tac "aa",simp)
apply auto
done



lemma [simp]: "false (a, b) = False"
by(simp add:false_def)

lemma [simp]: "true (a, b) = True"
by(simp add:true_def)

lemma textbook_true: "I⟦true τ = True"
by(simp add: Sem_def true_def)

lemma textbook_false: "I⟦false τ = False"
by(simp add: Sem_def false_def)

text ‹
\begin{table}[htbp]
   \centering
   \begin{tabu}{lX[,c,]}
      \toprule
      Name & Theorem \\
      \midrule
      @{thm [source] textbook_invalid}  & @{thm  [display=false] textbook_invalid} \\
      @{thm [source] textbook_null_fun}  & @{thm [display=false] textbook_null_fun} \\
      @{thm [source] textbook_true}   & @{thm  [display=false] textbook_true} \\
      @{thm [source] textbook_false} & @{thm [display=false] textbook_false} \\
      \bottomrule
   \end{tabu}
   \caption{Basic semantic constant definitions of the logic}
   \label{tab:sem_basic_constants}
\end{table}
›

subsection‹Validity and Definedness›

text‹However, this has also the consequence that core concepts like definedness,
validity and even cp have to be redefined on this type class:›

definition valid :: "('𝔄,'a::null)val  ('𝔄)Boolean" ("υ _" [100]100)
where   "υ X   λ τ . if X τ = bot τ then false τ else true τ"

lemma valid1[simp]: "υ invalid = false"
  by(rule ext,simp add: valid_def bot_fun_def bot_option_def
                        invalid_def true_def false_def)
lemma valid2[simp]: "υ null = true"
  by(rule ext,simp add: valid_def bot_fun_def bot_option_def null_is_valid
                        null_fun_def invalid_def true_def false_def)
lemma valid3[simp]: "υ true = true"
  by(rule ext,simp add: valid_def bot_fun_def bot_option_def null_is_valid
                        null_fun_def invalid_def true_def false_def)
lemma valid4[simp]: "υ false = true"
  by(rule ext,simp add: valid_def bot_fun_def bot_option_def null_is_valid
                        null_fun_def invalid_def true_def false_def)
text_raw‹\isatagafp›
lemma cp_valid: "(υ X) τ = (υ (λ _. X τ)) τ"
by(simp add: valid_def)
text_raw‹\endisatagafp›

definition defined :: "('𝔄,'a::null)val  ('𝔄)Boolean" ("δ _" [100]100)
where   "δ X   λ τ . if X τ = bot τ   X τ = null τ then false τ else true τ"

text‹The generalized definitions of invalid and definedness have the same
properties as the old ones :›
lemma defined1[simp]: "δ invalid = false"
  by(rule ext,simp add: defined_def bot_fun_def bot_option_def
                        null_def invalid_def true_def false_def)
lemma defined2[simp]: "δ null = false"
  by(rule ext,simp add: defined_def bot_fun_def bot_option_def
                        null_def null_option_def null_fun_def invalid_def true_def false_def)
lemma defined3[simp]: "δ true = true"
  by(rule ext,simp add: defined_def bot_fun_def bot_option_def null_is_valid null_option_def
                        null_fun_def invalid_def true_def false_def)
lemma defined4[simp]: "δ false = true"
  by(rule ext,simp add: defined_def bot_fun_def bot_option_def null_is_valid null_option_def
                        null_fun_def invalid_def true_def false_def)
lemma defined5[simp]: "δ δ X = true"
  by(rule ext,
     auto simp:           defined_def true_def false_def
                bot_fun_def bot_option_def null_option_def null_fun_def)
lemma defined6[simp]: "δ υ X = true"
  by(rule ext,
     auto simp: valid_def defined_def true_def false_def
                bot_fun_def bot_option_def null_option_def null_fun_def)
lemma valid5[simp]: "υ υ X = true"
  by(rule ext,
     auto simp: valid_def             true_def false_def
                bot_fun_def bot_option_def null_option_def null_fun_def)
lemma valid6[simp]: "υ δ X = true"
  by(rule ext,
     auto simp: valid_def defined_def true_def false_def
                bot_fun_def bot_option_def null_option_def null_fun_def)
text_raw‹\isatagafp›
lemma cp_defined:"(δ X)τ = (δ (λ _. X τ)) τ"
by(simp add: defined_def)
text_raw‹\endisatagafp›

text‹The definitions above for the constants @{const defined} and @{const valid}
can be rewritten into the conventional semantic "textbook" format  as follows:›

lemma textbook_defined: "I⟦δ(X) τ = (if I⟦X τ = I⟦bot τ   I⟦X τ = I⟦null τ
                                     then I⟦false τ
                                     else I⟦true τ)"
by(simp add: Sem_def defined_def)

lemma textbook_valid: "I⟦υ(X) τ = (if I⟦X τ = I⟦bot τ
                                   then I⟦false τ
                                   else I⟦true τ)"
by(simp add: Sem_def valid_def)


text ‹
\autoref{tab:sem_definedness} and \autoref{tab:alglaws_definedness}
summarize the results of this section.
\begin{table}[htbp]
   \centering
   \begin{tabu}{lX[,c,]}
      \toprule
      Name & Theorem \\
      \midrule
      @{thm [source] textbook_defined}  & @{thm [show_question_marks=false,display=false,margin=45] textbook_defined} \\
      @{thm [source] textbook_valid}   & @{thm [show_question_marks=false,display=false,margin=45] textbook_valid} \\
      \bottomrule
   \end{tabu}
   \caption{Basic predicate definitions of the logic.}
   \label{tab:sem_definedness}
\end{table}
\begin{table}[htbp]
   \centering
   \begin{tabu}{lX[,c,]}
      \toprule
      Name & Theorem \\
      \midrule
      @{thm [source] defined1}  & @{thm  defined1} \\
      @{thm [source] defined2}   & @{thm [display=false,margin=35] defined2} \\
      @{thm [source] defined3}   & @{thm [display=false,margin=35] defined3} \\
      @{thm [source] defined4}   & @{thm [display=false,margin=35] defined4} \\
      @{thm [source] defined5}   & @{thm [display=false,margin=35] defined5} \\
      @{thm [source] defined6}   & @{thm [display=false,margin=35] defined6} \\
      \bottomrule
   \end{tabu}
   \caption{Laws of the basic predicates of the logic.}
   \label{tab:alglaws_definedness}
\end{table}
›

subsection‹The Equalities of OCL \label{sec:equality}›
text‹
  The OCL contains a particular version of equality, written in
  Standard documents \inlineocl+_ = _+ and \inlineocl+_ <> _+ for its
  negation, which is referred as \emph{weak referential equality}
  hereafter and for which we use the symbol \inlineisar+_ ≐ _+
  throughout the formal part of this document. Its semantics is
  motivated by the desire of fast execution, and similarity to
  languages like Java and C, but does not satisfy the needs of logical
  reasoning over OCL expressions and specifications. We therefore
  introduce a second equality, referred as \emph{strong equality} or
  \emph{logical equality} and written \inlineisar+_ ≜ _+
  which is not present in the current standard but was discussed in
  prior texts on OCL like the Amsterdam
  Manifesto~\cite{cook.ea::amsterdam:2002} and was identified as
  desirable extension of OCL in the Aachen
  Meeting~\cite{brucker.ea:summary-aachen:2013} in the future 2.5 OCL
  Standard. The purpose of strong equality is to define and reason
  over OCL. It is therefore a natural task in Featherweight OCL to
  formally investigate the somewhat quite complex relationship between
  these two.› text‹Strong equality has two motivations: a
  pragmatic one and a fundamental one.
  \begin{enumerate}
  \item The pragmatic reason is fairly simple: users of object-oriented languages want
    something like a ``shallow object value equality''.
    You will want to say
    \inlineisar+ a.boss ≜  b.boss@pre +
    instead of
\begin{isar}
  a.boss ≐ b.boss@pre and  (* just the pointers are equal! *)
  a.boss.name ≐ b.boss@pre.name@pre and
  a.boss.age ≐ b.boss@pre.age@pre
\end{isar}
      Breaking a shallow-object equality down to referential equality
      of attributes is cumbersome, error-prone, and makes
      specifications difficult to extend (add for example an attribute
      sex to your class, and check in your OCL specification
      everywhere that you did it right with your simulation of strong
      equality).  Therefore, languages like Java offer facilities
      to handle two different equalities, and it is problematic even
      in an execution oriented specification language to ignore
      shallow object equality because it is so common in the code.
    \item The fundamental reason goes as follows: whatever you do to
      reason consistently over a language, you need the concept of
      equality: you need to know what expressions can be replaced by
      others because they \emph{mean the same thing.}  People call
      this also ``Leibniz Equality'' because this philosopher brought
      this principle first explicitly to paper and shed some light
      over it. It is the theoretic foundation of what you do in an
      optimizing compiler: you replace expressions by \emph{equal}
      ones, which you hope are easier to evaluate. In a typed
      language, strong equality exists uniformly over all types, it is
      ``polymorphic'' $\_ = \_ :: \alpha * \alpha \rightarrow
      bool$---this is the way that equality is defined in HOL itself.
      We can express Leibniz principle as one logical rule of
      surprising simplicity and beauty:
    \begin{gather}
        s = t \Longrightarrow P(s) = P(t)
    \end{gather}
    ``Whenever we know, that $s$ is equal to $t$, we can replace the
    sub-expression $s$ in a term $P$ by $t$ and we have that the
    replacement is equal to the original.''
\end{enumerate}
›
text‹
  While weak referential equality is defined to be strict in the OCL
  standard, we will define strong equality as non-strict.  It is quite
  nasty (but not impossible) to define the logical equality in a
  strict way (the substitutivity rule above would look more complex),
  however, whenever references were used, strong equality is needed
  since references refer to particular states (pre or post), and that
  they mean the same thing can therefore not be taken for granted.
›

subsubsection‹Definition›
text‹
  The strict equality on basic types (actually on all types) must be
  exceptionally defined on @{term "null"}---otherwise the entire
  concept of null in the language does not make much sense. This is an
  important exception from the general rule that null
  arguments---especially if passed as ``self''-argument---lead to
  invalid results.
›


text‹
  We define strong equality extremely generic, even for types that
  contain a null› or ⊥› element. Strong
  equality is simply polymorphic in Featherweight OCL, \ie, is
  defined identical for all types in OCL and HOL.
›
definition StrongEq::"['𝔄 st  ,'𝔄 st  ]  ('𝔄)Boolean"  (infixl "" 30)
where     "X  Y   λ τ. X τ = Y τ "

text‹
  From this follow already elementary properties like:
›
lemma [simp,code_unfold]: "(true  false) = false"
by(rule ext, auto simp: StrongEq_def)

lemma [simp,code_unfold]: "(false  true) = false"
by(rule ext, auto simp: StrongEq_def)


subsubsection‹Fundamental Predicates on Strong Equality›

text‹Equality reasoning in OCL is not humpty dumpty. While strong equality
is clearly an equivalence:›
lemma StrongEq_refl [simp]: "(X  X) = true"
by(rule ext, simp add: null_def invalid_def true_def false_def StrongEq_def)

lemma StrongEq_sym: "(X  Y) = (Y  X)"
by(rule ext, simp add: eq_sym_conv invalid_def true_def false_def StrongEq_def)

lemma StrongEq_trans_strong [simp]:
  assumes A: "(X  Y) = true"
  and     B: "(Y  Z) = true"
  shows   "(X  Z) = true"
  apply(insert A B) apply(rule ext)
  apply(simp add: null_def invalid_def true_def false_def StrongEq_def)
  apply(drule_tac x=x in fun_cong)+
  by auto

text‹
    it is only in a limited sense a congruence, at least from the
    point of view of this semantic theory. The point is that it is
    only a congruence on OCL expressions, not arbitrary HOL
    expressions (with which we can mix Featherweight OCL expressions). A
    semantic---not syntactic---characterization of OCL expressions is
    that they are \emph{context-passing} or \emph{context-invariant},
    \ie, the context of an entire OCL expression, \ie the pre and
    post state it referes to, is passed constantly and unmodified to
    the sub-expressions, \ie, all sub-expressions inside an OCL
    expression refer to the same context. Expressed formally, this
    boils down to:
›
lemma StrongEq_subst :
  assumes cp: "X. P(X)τ = P(λ _. X τ)τ"
  and     eq: "(X  Y)τ = true τ"
  shows   "(P X  P Y)τ = true τ"
  apply(insert cp eq)
  apply(simp add: null_def invalid_def true_def false_def StrongEq_def)
  apply(subst cp[of X])
  apply(subst cp[of Y])
  by simp

lemma defined7[simp]: "δ (X  Y) = true"
  by(rule ext,
     auto simp: defined_def           true_def false_def StrongEq_def
                bot_fun_def bot_option_def null_option_def null_fun_def)

lemma valid7[simp]: "υ (X  Y) = true"
  by(rule ext,
     auto simp: valid_def true_def false_def StrongEq_def
                bot_fun_def bot_option_def null_option_def null_fun_def)

lemma cp_StrongEq: "(X  Y) τ = ((λ _. X τ)  (λ _. Y τ)) τ"
by(simp add: StrongEq_def)

subsection‹Logical Connectives and their Universal Properties›
text‹
  It is a design goal to give OCL a semantics that is as closely as
  possible to a ``logical system'' in a known sense; a specification
  logic where the logical connectives can not be understood other that
  having the truth-table aside when reading fails its purpose in our
  view.

  Practically, this means that we want to give a definition to the
  core operations to be as close as possible to the lattice laws; this
  makes also powerful symbolic normalization of OCL specifications
  possible as a pre-requisite for automated theorem provers. For
  example, it is still possible to compute without any definedness
  and validity reasoning the DNF of an OCL specification; be it for
  test-case generations or for a smooth transition to a two-valued
  representation of the specification amenable to fast standard
  SMT-solvers, for example.

  Thus, our representation of the OCL is merely a 4-valued
  Kleene-Logics with @{term "invalid"} as least, @{term "null"} as
  middle and @{term "true"} resp.  @{term "false"} as unrelated
  top-elements.
›


definition OclNot :: "('𝔄)Boolean  ('𝔄)Boolean" ("not")
where     "not X   λ τ . case X τ of
                                     
                           |         
                           |  x     ¬ x "



lemma cp_OclNot: "(not X)τ = (not (λ _. X τ)) τ"
by(simp add: OclNot_def)

lemma OclNot1[simp]: "not invalid = invalid"
  by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def bot_option_def)

lemma OclNot2[simp]: "not null = null"
  by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def
                        bot_option_def null_fun_def null_option_def )

lemma OclNot3[simp]: "not true = false"
  by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def)

lemma OclNot4[simp]: "not false = true"
  by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def)


lemma OclNot_not[simp]: "not (not X) = X"
  apply(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def)
  apply(case_tac "X x", simp_all)
  apply(case_tac "a", simp_all)
  done

lemma OclNot_inject: " x y. not x = not y  x = y"
  by(subst OclNot_not[THEN sym], simp)

definition OclAnd :: "[('𝔄)Boolean, ('𝔄)Boolean]  ('𝔄)Boolean" (infixl "and" 30)
where     "X and Y   (λ τ . case X τ of
                          False                False
                        |          (case Y τ of
                                        False  False
                                      | _         )
                        |        (case Y τ of
                                        False  False
                                      |          
                                      | _         )
                        | True                 Y τ)"


text‹
  Note that @{term "not"} is \emph{not} defined as a strict function;
  proximity to lattice laws implies that we \emph{need} a definition
  of @{term "not"} that satisfies not(not(x))=x›.
›

text‹
  In textbook notation, the logical core constructs @{const
    "OclNot"} and @{const "OclAnd"} were represented as follows:
›
lemma textbook_OclNot:
     "I⟦not(X) τ =  (case I⟦X τ of       
                                 |        
                                 |  x    ¬ x )"
by(simp add: Sem_def OclNot_def)

lemma textbook_OclAnd:
     "I⟦X and Y τ = (case I⟦X τ of
                               (case I⟦Y τ of
                                                
                                          |   
                                          | True   
                                          | False   False)
                        |     (case I⟦Y τ of
                                                
                                          |   
                                          | True  
                                          | False   False)
                        | True  (case I⟦Y τ of
                                                
                                          |   
                                          | y   y)
                        | False    False )"
by(simp add: OclAnd_def Sem_def split: option.split bool.split)

definition OclOr :: "[('𝔄)Boolean, ('𝔄)Boolean]  ('𝔄)Boolean"            (infixl "or" 25)
where    "X or Y  not(not X and not Y)"

definition OclImplies :: "[('𝔄)Boolean, ('𝔄)Boolean]  ('𝔄)Boolean"       (infixl "implies" 25)
where    "X implies Y  not X or Y"

lemma cp_OclAnd:"(X and Y) τ = ((λ _. X τ) and (λ _. Y τ)) τ"
by(simp add: OclAnd_def)

lemma cp_OclOr:"((X::('𝔄)Boolean) or Y) τ = ((λ _. X τ) or (λ _. Y τ)) τ"
apply(simp add: OclOr_def)
apply(subst cp_OclNot[of "not (λ_. X τ) and not (λ_. Y τ)"])
apply(subst cp_OclAnd[of "not (λ_. X τ)" "not (λ_. Y τ)"])
by(simp add: cp_OclNot[symmetric] cp_OclAnd[symmetric] )


lemma cp_OclImplies:"(X implies Y) τ = ((λ _. X τ) implies (λ _. Y τ)) τ"
apply(simp add: OclImplies_def)
apply(subst cp_OclOr[of "not (λ_. X τ)" "(λ_. Y τ)"])
by(simp add: cp_OclNot[symmetric] cp_OclOr[symmetric] )

lemma OclAnd1[simp]: "(invalid and true) = invalid"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def)
lemma OclAnd2[simp]: "(invalid and false) = false"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def)
lemma OclAnd3[simp]: "(invalid and null) = invalid"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
                        null_fun_def null_option_def)
lemma OclAnd4[simp]: "(invalid and invalid) = invalid"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def)

lemma OclAnd5[simp]: "(null and true) = null"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
                        null_fun_def null_option_def)
lemma OclAnd6[simp]: "(null and false) = false"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
                        null_fun_def null_option_def)
lemma OclAnd7[simp]: "(null and null) = null"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
                        null_fun_def null_option_def)
lemma OclAnd8[simp]: "(null and invalid) = invalid"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
                        null_fun_def null_option_def)

lemma OclAnd9[simp]: "(false and true) = false"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
lemma OclAnd10[simp]: "(false and false) = false"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
lemma OclAnd11[simp]: "(false and null) = false"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
lemma OclAnd12[simp]: "(false and invalid) = false"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)

lemma OclAnd13[simp]: "(true and true) = true"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
lemma OclAnd14[simp]: "(true and false) = false"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
lemma OclAnd15[simp]: "(true and null) = null"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
                        null_fun_def null_option_def)
lemma OclAnd16[simp]: "(true and invalid) = invalid"
  by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
                        null_fun_def null_option_def)

lemma OclAnd_idem[simp]: "(X and X) = X"
  apply(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
  apply(case_tac "X x", simp_all)
  apply(case_tac "a", simp_all)
  apply(case_tac "aa", simp_all)
  done

lemma OclAnd_commute: "(X and Y) = (Y and X)"
  by(rule ext,auto simp:true_def false_def OclAnd_def invalid_def
                   split: option.split option.split_asm
                          bool.split bool.split_asm)


lemma OclAnd_false1[simp]: "(false and X) = false"
  apply(rule ext, simp add: OclAnd_def)
  apply(auto simp:true_def false_def invalid_def
             split: option.split option.split_asm)
  done

lemma OclAnd_false2[simp]: "(X and false) = false"
  by(simp add: OclAnd_commute)


lemma OclAnd_true1[simp]: "(true and X) = X"
  apply(rule ext, simp add: OclAnd_def)
  apply(auto simp:true_def false_def invalid_def
             split: option.split option.split_asm)
  done

lemma OclAnd_true2[simp]: "(X and true) = X"
  by(simp add: OclAnd_commute)

lemma OclAnd_bot1[simp]: "τ. X τ  false τ  (bot and X) τ = bot τ"
  apply(simp add: OclAnd_def)
  apply(auto simp:true_def false_def bot_fun_def bot_option_def
             split: option.split option.split_asm)
done

lemma OclAnd_bot2[simp]: "τ. X τ  false τ  (X and bot) τ = bot τ"
  by(simp add: OclAnd_commute)

lemma OclAnd_null1[simp]: "τ. X τ  false τ  X τ  bot τ  (null and X) τ = null τ"
  apply(simp add: OclAnd_def)
  apply(auto simp:true_def false_def bot_fun_def bot_option_def null_fun_def null_option_def
             split: option.split option.split_asm)
done

lemma OclAnd_null2[simp]: "τ. X τ  false τ  X τ  bot τ  (X and null) τ = null τ"
  by(simp add: OclAnd_commute)

lemma OclAnd_assoc: "(X and (Y and Z)) = (X and Y and Z)"
  apply(rule ext, simp add: OclAnd_def)
  apply(auto simp:true_def false_def null_def invalid_def
             split: option.split option.split_asm
                    bool.split bool.split_asm)
done


lemma OclOr1[simp]: "(invalid or true) = true"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
                       bot_option_def)
lemma OclOr2[simp]: "(invalid or false) = invalid"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
                       bot_option_def)
lemma OclOr3[simp]: "(invalid or null) = invalid"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
                       bot_option_def null_fun_def null_option_def)
lemma OclOr4[simp]: "(invalid or invalid) = invalid"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
                       bot_option_def)

lemma OclOr5[simp]: "(null or true) = true"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
                       bot_option_def null_fun_def null_option_def)
lemma OclOr6[simp]: "(null or false) = null"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
                       bot_option_def null_fun_def null_option_def)
lemma OclOr7[simp]: "(null or null) = null"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
                       bot_option_def null_fun_def null_option_def)
lemma OclOr8[simp]: "(null or invalid) = invalid"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
                       bot_option_def null_fun_def null_option_def)

lemma OclOr_idem[simp]: "(X or X) = X"
  by(simp add: OclOr_def)

lemma OclOr_commute: "(X or Y) = (Y or X)"
  by(simp add: OclOr_def OclAnd_commute)

lemma OclOr_false1[simp]: "(false or Y) = Y"
  by(simp add: OclOr_def)

lemma OclOr_false2[simp]: "(Y or false) = Y"
  by(simp add: OclOr_def)

lemma OclOr_true1[simp]: "(true or Y) = true"
  by(simp add: OclOr_def)

lemma OclOr_true2: "(Y or true) = true"
  by(simp add: OclOr_def)

lemma OclOr_bot1[simp]: "τ. X τ  true τ  (bot or X) τ = bot τ"
  apply(simp add: OclOr_def OclAnd_def OclNot_def)
  apply(auto simp:true_def false_def bot_fun_def bot_option_def
             split: option.split option.split_asm)
done

lemma OclOr_bot2[simp]: "τ. X τ  true τ  (X or bot) τ = bot τ"
  by(simp add: OclOr_commute)

lemma OclOr_null1[simp]: "τ. X τ  true τ  X τ  bot τ  (null or X) τ = null τ"
  apply(simp add: OclOr_def OclAnd_def OclNot_def)
  apply(auto simp:true_def false_def bot_fun_def bot_option_def null_fun_def null_option_def
             split: option.split option.split_asm)
  apply (metis (full_types) bool.simps(3) bot_option_def null_is_valid null_option_def)
by (metis (full_types) bool.simps(3) option.distinct(1) option.sel)

lemma OclOr_null2[simp]: "τ. X τ  true τ  X τ  bot τ  (X or null) τ = null τ"
  by(simp add: OclOr_commute)

lemma OclOr_assoc: "(X or (Y or Z)) = (X or Y or Z)"
  by(simp add: OclOr_def OclAnd_assoc)

lemma deMorgan1: "not(X and Y) = ((not X) or (not Y))"
  by(simp add: OclOr_def)

lemma deMorgan2: "not(X or Y) = ((not X) and (not Y))"
  by(simp add: OclOr_def)

lemma OclImplies_true1[simp]:"(true implies X) = X"
  by(simp add: OclImplies_def)

lemma OclImplies_true2[simp]: "(X implies true) = true"
  by(simp add: OclImplies_def OclOr_true2)

lemma OclImplies_false1[simp]:"(false implies X) = true"
  by(simp add: OclImplies_def)

subsection‹A Standard Logical Calculus for OCL›

definition OclValid  :: "[('𝔄)st, ('𝔄)Boolean]  bool" ("(1(_)/  (_))" 50)
where     "τ  P  ((P τ) = true τ)"

syntax OclNonValid  :: "[('𝔄)st, ('𝔄)Boolean]  bool" ("(1(_)/ |≠ (_))" 50)

translations "τ |≠ P" == "¬(τ  P)" 

subsubsection‹Global vs. Local Judgements›
lemma transform1: "P = true  τ  P"
by(simp add: OclValid_def)


lemma transform1_rev: " τ. τ  P  P = true"
by(rule ext, auto simp: OclValid_def true_def)

lemma transform2: "(P = Q)  ((τ  P) = (τ  Q))"
by(auto simp: OclValid_def)

lemma transform2_rev: " τ. (τ  δ P)  (τ  δ Q)  (τ  P) = (τ  Q)  P = Q"
apply(rule ext,auto simp: OclValid_def true_def defined_def)
apply(erule_tac x=a in allE)
apply(erule_tac x=b in allE)
apply(auto simp: false_def true_def defined_def bot_Boolean_def null_Boolean_def
                 split: option.split_asm HOL.if_split_asm)
done

text‹However, certain properties (like transitivity) can not
       be \emph{transformed} from the global level to the local one,
       they have to be re-proven on the local level.›

lemma (*transform3:*)
assumes H : "P = true  Q = true"
shows "τ  P  τ  Q"
apply(simp add: OclValid_def)
apply(rule H[THEN fun_cong])
apply(rule ext)
oops

subsubsection‹Local Validity and Meta-logic›
text‹\label{sec:localVal}›

lemma foundation1[simp]: "τ  true"
by(auto simp: OclValid_def)

lemma foundation2[simp]: "¬(τ  false)"
by(auto simp: OclValid_def true_def false_def)

lemma foundation3[simp]: "¬(τ  invalid)"
by(auto simp: OclValid_def true_def false_def invalid_def bot_option_def)

lemma foundation4[simp]: "¬(τ  null)"
by(auto simp: OclValid_def true_def false_def null_def null_fun_def null_option_def bot_option_def)

lemma bool_split[simp]:
"(τ  (x  invalid))  (τ  (x  null))  (τ  (x  true))  (τ  (x  false))"
apply(insert bool_split_0[of x τ], auto)
apply(simp_all add: OclValid_def StrongEq_def true_def null_def invalid_def)
done

lemma defined_split:
"(τ  δ x) = ((¬(τ  (x  invalid)))  (¬ (τ  (x  null))))"
by(simp add:defined_def true_def false_def invalid_def null_def
               StrongEq_def OclValid_def bot_fun_def null_fun_def)

lemma valid_bool_split: "(τ  υ A) = ((τ  A  null)  (τ  A)   (τ  not A)) "
by(auto simp:valid_def true_def false_def invalid_def null_def OclNot_def
             StrongEq_def OclValid_def bot_fun_def bot_option_def null_option_def null_fun_def)

lemma defined_bool_split: "(τ  δ A) = ((τ  A)  (τ  not A))"
by(auto simp:defined_def true_def false_def invalid_def null_def OclNot_def
             StrongEq_def OclValid_def bot_fun_def bot_option_def null_option_def null_fun_def)



lemma foundation5:
"τ  (P and Q)  (τ  P)  (τ  Q)"
by(simp add: OclAnd_def OclValid_def true_def false_def defined_def
             split: option.split option.split_asm bool.split bool.split_asm)

lemma foundation6:
"τ  P  τ  δ P"
by(simp add: OclNot_def OclValid_def true_def false_def defined_def
                null_option_def null_fun_def bot_option_def bot_fun_def
             split: option.split option.split_asm)


lemma foundation7[simp]:
"(τ  not (δ x)) = (¬ (τ  δ x))"
by(simp add: OclNot_def OclValid_def true_def false_def defined_def
             split: option.split option.split_asm)

lemma foundation7'[simp]:
"(τ  not (υ x)) = (¬ (τ  υ x))"
by(simp add: OclNot_def OclValid_def true_def false_def valid_def
             split: option.split option.split_asm)


text‹
  Key theorem for the $\delta$-closure: either an expression is
  defined, or it can be replaced (substituted via StrongEq_L_subst2›;
  see below) by invalid› or null›. Strictness-reduction rules will
  usually reduce these substituted terms drastically.
›


lemma foundation8:
"(τ  δ x)  (τ  (x  invalid))  (τ  (x  null))"
proof -
  have 1 : "(τ  δ x)  (¬(τ  δ x))" by auto
  have 2 : "(¬(τ  δ x)) = ((τ  (x  invalid))  (τ  (x  null)))"
           by(simp only: defined_split, simp)
  show ?thesis by(insert 1, simp add:2)
qed


lemma foundation9:
"τ  δ x  (τ  not x) = (¬ (τ  x))"
apply(simp add: defined_split )
by(auto simp: OclNot_def null_fun_def null_option_def bot_option_def
                 OclValid_def invalid_def true_def null_def StrongEq_def)

lemma foundation9':
"τ  not x  ¬ (τ  x)"
by(auto simp: foundation6 foundation9)

lemma foundation9'':
"            τ  not x  τ  δ x"
by(metis OclNot3 OclNot_not OclValid_def cp_OclNot cp_defined defined4)

lemma foundation10:
"τ  δ x  τ  δ y  (τ  (x and y)) = ( (τ  x)  (τ  y))"
apply(simp add: defined_split)
by(auto simp: OclAnd_def OclValid_def invalid_def
              true_def null_def StrongEq_def null_fun_def null_option_def bot_option_def
        split:bool.split_asm)

lemma foundation10': "(τ  (A and B)) = ((τ  A)  (τ  B))" (* stronger than foundation !*)
by(auto dest:foundation5 simp:foundation6 foundation10)

lemma foundation11:
"τ  δ x   τ  δ y  (τ  (x or y)) = ( (τ  x)  (τ  y))"
apply(simp add: defined_split)
by(auto simp: OclNot_def OclOr_def OclAnd_def OclValid_def invalid_def
              true_def null_def StrongEq_def null_fun_def null_option_def bot_option_def
        split:bool.split_asm bool.split)



lemma foundation12:
"τ  δ x  (τ  (x implies y)) = ( (τ  x)  (τ  y))"
apply(simp add: defined_split)
by(auto simp: OclNot_def OclOr_def OclAnd_def OclImplies_def bot_option_def
              OclValid_def invalid_def true_def null_def StrongEq_def null_fun_def null_option_def
        split:bool.split_asm bool.split option.split_asm)

lemma foundation13:"(τ  A  true)    = (τ  A)"
by(auto simp: OclNot_def  OclValid_def invalid_def true_def null_def StrongEq_def
              split:bool.split_asm bool.split)

lemma foundation14:"(τ  A  false)   = (τ  not A)"
by(auto simp: OclNot_def  OclValid_def invalid_def false_def true_def null_def StrongEq_def
        split:bool.split_asm bool.split option.split)

lemma foundation15:"(τ  A  invalid) = (τ  not(υ A))"
by(auto simp: OclNot_def OclValid_def valid_def invalid_def false_def true_def null_def
              StrongEq_def bot_option_def null_fun_def null_option_def bot_option_def bot_fun_def
        split:bool.split_asm bool.split option.split)


(* ... and the usual rules on strictness, definedness propoagation, and cp ... *)
lemma foundation16: "τ  (δ X) = (X τ  bot  X τ  null)"
by(auto simp: OclValid_def defined_def false_def true_def  bot_fun_def null_fun_def
        split:if_split_asm)

lemma foundation16'': "¬(τ  (δ X)) = ((τ  (X  invalid))  (τ  (X  null)))"
apply(simp add: foundation16)
by(auto simp:defined_def false_def true_def  bot_fun_def null_fun_def OclValid_def StrongEq_def invalid_def)

(* correcter rule; the previous is deprecated *)
lemma foundation16': "(τ  (δ X)) = (X τ  invalid τ  X τ  null τ)"
apply(simp add:invalid_def null_def null_fun_def)
by(auto simp: OclValid_def defined_def false_def true_def  bot_fun_def null_fun_def
        split:if_split_asm)



lemma foundation18: "(τ  (υ X)) = (X τ  invalid τ)"
by(auto simp: OclValid_def valid_def false_def true_def bot_fun_def invalid_def
        split:if_split_asm)

(*legacy*)
lemma foundation18': "(τ  (υ X)) = (X τ  bot)"
by(auto simp: OclValid_def valid_def false_def true_def bot_fun_def
        split:if_split_asm)

lemma foundation18'': "(τ  (υ X) )=  (¬(τ  (X  invalid)))"
by(auto simp:foundation15)


lemma foundation20 : "τ  (δ X)  τ  υ X"
by(simp add: foundation18 foundation16 invalid_def)

lemma foundation21: "(not A  not B) = (A  B)"
by(rule ext, auto simp: OclNot_def StrongEq_def
                     split: bool.split_asm HOL.if_split_asm option.split)

lemma foundation22: "(τ  (X  Y)) = (X τ = Y τ)"
by(auto simp: StrongEq_def OclValid_def true_def)

lemma foundation23: "(τ  P) = (τ  (λ _ . P τ))"
by(auto simp: OclValid_def true_def)



lemma foundation24:"(τ  not(X  Y)) = (X τ  Y τ)"
by(simp add: StrongEq_def  OclValid_def OclNot_def true_def)

lemma foundation25: "τ  P  τ  (P or Q)"
by(simp add: OclOr_def OclNot_def OclAnd_def OclValid_def true_def)

lemma foundation25': "τ  Q  τ  (P or Q)"
by(subst OclOr_commute, simp add: foundation25)


lemma foundation26:
assumes defP: "τ  δ P"
assumes defQ: "τ  δ Q"
assumes H: "τ  (P or Q)"
assumes P: "τ  P  R"
assumes Q: "τ  Q  R"
shows "R"
by(insert H, subst (asm) foundation11[OF defP defQ], erule disjE, simp_all add: P Q)

lemma foundation27: "τ  A  (τ  A implies B) = (τ  B)" 
by (simp add: foundation12 foundation6)

lemma defined_not_I : "τ  δ (x)  τ  δ (not x)"
  by(auto simp: OclNot_def null_def invalid_def defined_def valid_def OclValid_def
                  true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def
             split: option.split_asm HOL.if_split_asm)

lemma valid_not_I : "τ  υ (x)  τ  υ (not x)"
  by(auto simp: OclNot_def null_def invalid_def defined_def valid_def OclValid_def
                  true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def
          split: option.split_asm option.split HOL.if_split_asm)

lemma defined_and_I : "τ  δ (x)   τ  δ (y)  τ  δ (x and y)"
  apply(simp add: OclAnd_def null_def invalid_def defined_def valid_def OclValid_def
                  true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def
             split: option.split_asm HOL.if_split_asm)
  apply(auto simp: null_option_def split: bool.split)
  by(case_tac "ya",simp_all)

lemma valid_and_I :   "τ  υ (x)   τ  υ (y)  τ  υ (x and y)"
  apply(simp add: OclAnd_def null_def invalid_def defined_def valid_def OclValid_def
                  true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def
             split: option.split_asm HOL.if_split_asm)
  by(auto simp: null_option_def split: option.split bool.split)

lemma defined_or_I : "τ  δ (x)   τ  δ (y)  τ  δ (x or y)"
by(simp add: OclOr_def defined_and_I defined_not_I)

lemma valid_or_I :   "τ  υ (x)   τ  υ (y)  τ  υ (x or y)"
by(simp add: OclOr_def valid_and_I valid_not_I)

subsubsection‹Local Judgements and Strong Equality›

lemma StrongEq_L_refl: "τ  (x  x)"
by(simp add: OclValid_def StrongEq_def)


lemma StrongEq_L_sym: "τ  (x  y)  τ  (y  x)"
by(simp add: StrongEq_sym)

lemma StrongEq_L_trans: "τ  (x  y)  τ  (y  z)  τ  (x  z)"
by(simp add: OclValid_def StrongEq_def true_def)



text‹In order to establish substitutivity (which does not
hold in general HOL formulas) we introduce the following
predicate that allows for a calculus of the necessary side-conditions.›
definition cp   :: "(('𝔄,) val  ('𝔄,) val)  bool"
where     "cp P  ( f.  X τ. P X τ = f (X τ) τ)"


text‹The rule of substitutivity in Featherweight OCL holds only
for context-passing expressions, \ie those that pass
the context τ› without changing it. Fortunately, all
operators of the OCL language satisfy this property
(but not all HOL operators).›

lemma StrongEq_L_subst1: " τ. cp P  τ  (x  y)  τ  (P x  P y)"
by(auto simp: OclValid_def StrongEq_def true_def cp_def)

lemma StrongEq_L_subst2:
" τ.  cp P  τ  (x  y)  τ  (P x)  τ  (P y)"
by(auto simp: OclValid_def StrongEq_def true_def cp_def)

lemma StrongEq_L_subst2_rev: "τ  y  x  cp P  τ  P x  τ  P y"
apply(erule StrongEq_L_subst2)
apply(erule StrongEq_L_sym)  
by assumption

lemma  StrongEq_L_subst3:
assumes cp: "cp P"
and     eq: "τ  (x  y)"
shows       "(τ  P x) = (τ  P y)"
apply(rule iffI)
apply(rule StrongEq_L_subst2[OF cp,OF eq],simp)
apply(rule StrongEq_L_subst2[OF cp,OF eq[THEN StrongEq_L_sym]],simp)
done

lemma  StrongEq_L_subst3_rev:
assumes eq: "τ  (x  y)" 
and     cp: "cp P"
shows       "(τ  P x) = (τ  P y)"
by(insert cp, erule StrongEq_L_subst3, rule eq)

lemma  StrongEq_L_subst4_rev:
assumes eq: "τ  (x  y)" 
and     cp: "cp P"
shows       "(¬(τ  P x)) = (¬(τ  P y))"
thm arg_cong[of _ _ "Not"]
apply(rule arg_cong[of _ _ "Not"])
by(insert cp, erule StrongEq_L_subst3, rule eq)

lemma cpI1:
"( X τ. f X τ = f(λ_. X τ) τ)  cp P  cp(λX. f (P X))"
apply(auto simp: true_def cp_def)
apply(rule exI, (rule allI)+)
by(erule_tac x="P X" in allE, auto)

lemma cpI2:
"( X Y τ. f X Y τ = f(λ_. X τ)(λ_. Y τ) τ) 
 cp P  cp Q  cp(λX. f (P X) (Q X))"
apply(auto simp: true_def cp_def)
apply(rule exI, (rule allI)+)
by(erule_tac x="P X" in allE, auto)

lemma cpI3:
"( X Y Z τ. f X Y Z τ = f(λ_. X τ)(λ_. Y τ)(λ_. Z τ) τ) 
 cp P  cp Q  cp R  cp(λX. f (P X) (Q X) (R X))"
apply(auto simp: cp_def)
apply(rule exI, (rule allI)+)
by(erule_tac x="P X" in allE, auto)

lemma cpI4:
"( W X Y Z τ. f W X Y Z τ = f(λ_. W τ)(λ_. X τ)(λ_. Y τ)(λ_. Z τ) τ) 
 cp P  cp Q  cp R  cp S  cp(λX. f (P X) (Q X) (R X) (S X))"
apply(auto simp: cp_def)
apply(rule exI, (rule allI)+)
by(erule_tac x="P X" in allE, auto)

lemma cpI5:
"( V W X Y Z τ. f V W X Y Z τ = f(λ_. V τ) (λ_. W τ)(λ_. X τ)(λ_. Y τ)(λ_. Z τ) τ) 
 cp N  cp P  cp Q  cp R  cp S  cp(λX. f (N X) (P X) (Q X) (R X) (S X))"
apply(auto simp: cp_def)
apply(rule exI, (rule allI)+)
by(erule_tac x="N X" in allE, auto)


lemma cp_const : "cp(λ_. c)"
  by (simp add: cp_def, fast)

lemma cp_id :     "cp(λX. X)"
  by (simp add: cp_def, fast)

text_raw‹\isatagafp›
 
lemmas cp_intro[intro!,simp,code_unfold] =
       cp_const
       cp_id
       cp_defined[THEN allI[THEN allI[THEN cpI1], of defined]]
       cp_valid[THEN allI[THEN allI[THEN cpI1], of valid]]
       cp_OclNot[THEN allI[THEN allI[THEN cpI1], of not]]
       cp_OclAnd[THEN allI[THEN allI[THEN allI[THEN cpI2]], of "(and)"]]
       cp_OclOr[THEN allI[THEN allI[THEN allI[THEN cpI2]], of "(or)"]]
       cp_OclImplies[THEN allI[THEN allI[THEN allI[THEN cpI2]], of "(implies)"]]
       cp_StrongEq[THEN allI[THEN allI[THEN allI[THEN cpI2]],
                   of "StrongEq"]]

text_raw‹\endisatagafp›
       
       
subsection‹OCL's if then else endif›

definition OclIf :: "[('𝔄)Boolean , ('𝔄,::null) val, ('𝔄,) val]  ('𝔄,) val"
                     ("if (_) then (_) else (_) endif" [10,10,10]50)
where "(if C then B1 else B2 endif) = (λ τ. if (δ C) τ = true τ
                                           then (if (C τ) = true τ
                                                then B1 τ
                                                else B2 τ)
                                           else invalid τ)"


lemma cp_OclIf:"((if C then B1 else B2 endif) τ =
                  (if (λ _. C τ) then (λ _. B1 τ) else (λ _. B2 τ) endif) τ)"
by(simp only: OclIf_def, subst cp_defined, rule refl)
text_raw‹\isatagafp›

lemmas cp_intro'[intro!,simp,code_unfold] =
       cp_intro
       cp_OclIf[THEN allI[THEN allI[THEN allI[THEN allI[THEN cpI3]]], of "OclIf"]]
text_raw‹\endisatagafp›

lemma OclIf_invalid [simp]: "(if invalid then B1 else B2 endif) = invalid"
by(rule ext, auto simp: OclIf_def)

lemma OclIf_null [simp]: "(if null then B1 else B2 endif) = invalid"
by(rule ext, auto simp: OclIf_def)

lemma OclIf_true [simp]: "(if true then B1 else B2 endif) = B1"
by(rule ext, auto simp: OclIf_def)

lemma OclIf_true' [simp]: "τ  P  (if P then B1 else B2 endif)τ = B1 τ"
apply(subst cp_OclIf,auto simp: OclValid_def)
by(simp add:cp_OclIf[symmetric])

lemma OclIf_true'' [simp]: "τ  P  τ  (if P then B1 else B2 endif)  B1"
by(subst OclValid_def, simp add: StrongEq_def true_def)

lemma OclIf_false [simp]: "(if false then B1 else B2 endif) = B2"
by(rule ext, auto simp: OclIf_def)

lemma OclIf_false' [simp]: "τ  not P  (if P then B1 else B2 endif)τ = B2 τ"
apply(subst cp_OclIf)
apply(auto simp: foundation14[symmetric] foundation22)
by(auto simp: cp_OclIf[symmetric])


lemma OclIf_idem1[simp]:"(if δ X then A else A endif) = A"
by(rule ext, auto simp: OclIf_def)

lemma OclIf_idem2[simp]:"(if υ X then A else A endif) = A"
by(rule ext, auto simp: OclIf_def)

lemma OclNot_if[simp]:
"not(if P then C else E endif) = (if P then not C else not E endif)"
  (* non-trivial but elementary *)
  apply(rule OclNot_inject, simp)
  apply(rule ext)
  apply(subst cp_OclNot, simp add: OclIf_def)
  apply(subst cp_OclNot[symmetric])+
by simp


       
subsection‹Fundamental Predicates on Basic Types: Strict (Referential) Equality›

text‹
  In contrast to logical equality, the OCL standard defines an equality operation
  which we call ``strict referential equality''. It behaves differently for all
  types---on value types, it is basically a strict version of strong equality, 
  for defined values it behaves identical. But on object types it will compare 
  their references within the store. We  introduce strict referential equality 
  as an \emph{overloaded} concept and will handle it for
  each type instance individually.
›
consts StrictRefEq :: "[('𝔄,'a)val,('𝔄,'a)val]  ('𝔄)Boolean" (infixl "" 30)

text‹with {term "not"} we can express the notation:›

syntax
  "notequal"        :: "('𝔄)Boolean  ('𝔄)Boolean  ('𝔄)Boolean"   (infix "<>" 40)
translations
  "a <> b" == "CONST OclNot(a  b)"
       
text‹We will define instances of this equality in a case-by-case basis.›       
       
subsection‹Laws to Establish Definedness (\texorpdfstring{$\delta$}{d}-closure)›

text‹For the logical connectives, we have --- beyond
@{thm foundation6} --- the following facts:›
lemma OclNot_defargs:
"τ  (not P)  τ  δ P"
by(auto simp: OclNot_def OclValid_def true_def invalid_def defined_def false_def
                 bot_fun_def bot_option_def null_fun_def null_option_def
        split: bool.split_asm HOL.if_split_asm option.split option.split_asm)


lemma OclNot_contrapos_nn:
 assumes A: "τ  δ A"
 assumes B: "τ  not B"
 assumes C: "τ  A  τ  B"
 shows      "τ  not A"
proof -
 have D : "τ  δ B" by(rule B[THEN OclNot_defargs])
 show ?thesis 
    apply(insert B,simp add: A D foundation9)
    by(erule contrapos_nn, auto intro: C)
qed


subsection‹A Side-calculus for Constant Terms›

definition "const X   τ τ'. X τ = X τ'"

lemma const_charn: "const X  X τ = X τ'"
by(auto simp: const_def)

lemma const_subst:
 assumes const_X: "const X"
     and const_Y: "const Y"
     and eq :     "X τ = Y τ"
     and cp_P:    "cp P"
     and pp :     "P Y τ = P Y τ'"
   shows "P X τ = P X τ'"
proof -
   have A: "Y. P Y τ = P (λ_. Y τ) τ"
      apply(insert cp_P, unfold cp_def)
      apply(elim exE, erule_tac x=Y in allE', erule_tac x=τ in allE)
      apply(erule_tac x="(λ_. Y τ)" in allE, erule_tac x=τ in allE)
      by simp
   have B: "Y. P Y τ' = P (λ_. Y τ') τ'"
      apply(insert cp_P, unfold cp_def)
      apply(elim exE, erule_tac x=Y in allE', erule_tac x=τ' in allE)
      apply(erule_tac x="(λ_. Y τ')" in allE, erule_tac x=τ' in allE)
      by simp
   have C: "X τ' = Y τ'"
      apply(rule trans, subst const_charn[OF const_X],rule eq)
      by(rule const_charn[OF const_Y])
   show ?thesis
      apply(subst A, subst B, simp add: eq C)
      apply(subst A[symmetric],subst B[symmetric])
      by(simp add:pp)
qed


lemma const_imply2 :
 assumes "τ τ'. P τ = P τ'  Q τ = Q τ'"
 shows "const P  const Q"
by(simp add: const_def, insert assms, blast)

lemma const_imply3 :
 assumes "τ τ'. P τ = P τ'  Q τ = Q τ'  R τ = R τ'"
 shows "const P  const Q  const R"
by(simp add: const_def, insert assms, blast)

lemma const_imply4 :
 assumes "τ τ'. P τ = P τ'  Q τ = Q τ'  R τ = R τ'  S τ = S τ'"
 shows "const P  const Q  const R  const S"
by(simp add: const_def, insert assms, blast)

lemma const_lam : "const (λ_. e)"
by(simp add: const_def)


lemma const_true[simp] : "const true"
by(simp add: const_def true_def)

lemma const_false[simp] : "const false"
by(simp add: const_def false_def)

lemma const_null[simp] : "const null"
by(simp add: const_def null_fun_def)

lemma const_invalid [simp]: "const invalid"
by(simp add: const_def invalid_def)

lemma const_bot[simp] : "const bot"
by(simp add: const_def bot_fun_def)



lemma const_defined :
 assumes "const X"
 shows   "const (δ X)"
by(rule const_imply2[OF _ assms],
   simp add: defined_def false_def true_def bot_fun_def bot_option_def null_fun_def null_option_def)

lemma const_valid :
 assumes "const X"
 shows   "const (υ X)"
by(rule const_imply2[OF _ assms],
   simp add: valid_def false_def true_def bot_fun_def null_fun_def assms)


lemma const_OclAnd :
  assumes "const X"
  assumes "const X'"
  shows   "const (X and X')"
by(rule const_imply3[OF _ assms], subst (1 2) cp_OclAnd, simp add: assms OclAnd_def)


lemma const_OclNot :
    assumes "const X"
    shows   "const (not X)"
by(rule const_imply2[OF _ assms],subst cp_OclNot,simp add: assms OclNot_def)

lemma const_OclOr :
  assumes "const X"
  assumes "const X'"
  shows   "const (X or X')"
by(simp add: assms OclOr_def const_OclNot const_OclAnd)

lemma const_OclImplies :
  assumes "const X"
  assumes "const X'"
  shows   "const (X implies X')"
by(simp add: assms OclImplies_def const_OclNot const_OclOr)

lemma const_StrongEq:
  assumes "const X"
  assumes "const X'"
  shows   "const(X  X')"
  apply(simp only: StrongEq_def const_def, intro allI)
  apply(subst assms(1)[THEN const_charn])
  apply(subst assms(2)[THEN const_charn])
  by simp
  
  
lemma const_OclIf :
  assumes "const B"
      and "const C1"
      and "const C2"
    shows "const (if B then C1 else C2 endif)"
 apply(rule const_imply4[OF _ assms],
       subst (1 2) cp_OclIf, simp only: OclIf_def cp_defined[symmetric])
 apply(simp add: const_defined[OF assms(1), simplified const_def, THEN spec, THEN spec]
                 const_true[simplified const_def, THEN spec, THEN spec]
                 assms[simplified const_def, THEN spec, THEN spec]
                 const_invalid[simplified const_def, THEN spec, THEN spec])
by (metis (no_types) bot_fun_def OclValid_def const_def const_true defined_def 
                 foundation16[THEN iffD1]  null_fun_def)

       

lemma const_OclValid1:
 assumes "const x"
 shows   "(τ  δ x) = (τ'  δ x)"
 apply(simp add: OclValid_def)
 apply(subst const_defined[OF assms, THEN const_charn])
 by(simp add: true_def)

lemma const_OclValid2:
 assumes "const x"
 shows   "(τ  υ x) = (τ'  υ x)"
 apply(simp add: OclValid_def)
 apply(subst const_valid[OF assms, THEN const_charn])
 by(simp add: true_def)


lemma const_HOL_if : "const C  const D  const F  const (λτ. if C τ then D τ else F τ)"
      by(auto simp: const_def)
lemma const_HOL_and: "const C  const D  const (λτ. C τ  D τ)"
      by(auto simp: const_def)
lemma const_HOL_eq : "const C  const D  const (λτ. C τ = D τ)" 
      apply(auto simp: const_def)
      apply(erule_tac x=τ in allE)
      apply(erule_tac x=τ in allE)
      apply(erule_tac x=τ' in allE)
      apply(erule_tac x=τ' in allE)
      apply simp
      apply(erule_tac x=τ in allE)
      apply(erule_tac x=τ in allE)
      apply(erule_tac x=τ' in allE)
      apply(erule_tac x=τ' in allE)
      by simp


lemmas const_ss = const_bot const_null  const_invalid  const_false  const_true  const_lam
                  const_defined const_valid const_StrongEq const_OclNot const_OclAnd
                  const_OclOr const_OclImplies const_OclIf
                  const_HOL_if const_HOL_and const_HOL_eq
               

text‹Miscellaneous: Overloading the syntax of ``bottom''›

notation bot ("")

end

Theory UML_PropertyProfiles

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_PropertyProfiles.thy ---
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2013-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)




theory UML_PropertyProfiles
imports  UML_Logic
begin

section‹Property Profiles for OCL Operators via Isabelle Locales›

text‹We use the Isabelle mechanism of a \emph{Locale} to generate the
common lemmas for each type and operator; Locales can be seen as a 
functor that takes a local theory and generates a number of theorems.
In our case, we will instantiate later these locales by the local theory 
of an operator definition and obtain the common rules for strictness, definedness
propagation, context-passingness and constance in a systematic way.
›

subsection‹Property Profiles for Monadic Operators›

locale profile_mono_scheme_defined =
   fixes f :: "('𝔄,::null)val  ('𝔄,::null)val"
   fixes g
   assumes def_scheme: "(f x)  λ τ. if (δ x) τ = true τ then g (x τ) else invalid τ"
begin
   lemma strict[simp,code_unfold]: " f invalid = invalid"
   by(rule ext, simp add: def_scheme true_def false_def)
 
   lemma null_strict[simp,code_unfold]: " f null = invalid"
   by(rule ext, simp add: def_scheme true_def false_def)

   lemma cp0 : "f X τ = f (λ _. X τ) τ"
   by(simp add: def_scheme  cp_defined[symmetric])
      
   lemma cp[simp,code_unfold] : " cp P  cp (λX. f (P X) )"
   by(rule cpI1[of "f"], intro allI, rule cp0, simp_all)
    
end

locale profile_mono_schemeV =
   fixes f :: "('𝔄,::null)val  ('𝔄,::null)val"
   fixes g
   assumes def_scheme: "(f x)  λ τ. if (υ x) τ = true τ then g (x τ) else invalid τ"
begin
   lemma strict[simp,code_unfold]: " f invalid = invalid"
   by(rule ext, simp add: def_scheme true_def false_def)
 
   lemma cp0 : "f X τ = f (λ _. X τ) τ"
   by(simp add: def_scheme  cp_valid[symmetric])
      
   lemma cp[simp,code_unfold] : " cp P  cp (λX. f (P X) )"
   by(rule cpI1[of "f"], intro allI, rule cp0, simp_all)
    
end

locale profile_monod = profile_mono_scheme_defined +
   assumes " x. x  bot  x  null  g x  bot"
begin
  
   lemma const[simp,code_unfold] : 
          assumes C1 :"const X"
          shows       "const(f X)"
      proof -
        have const_g : "const (λτ. g (X τ))"  by(insert C1, auto simp:const_def, metis)
        show ?thesis   by(simp_all add : def_scheme const_ss C1 const_g)
      qed  
end

locale profile_mono0 = profile_mono_scheme_defined +
   assumes def_body:  " x. x  bot  x  null  g x  bot  g x  null"

sublocale profile_mono0 < profile_monod
by(unfold_locales, simp add: def_scheme, simp add: def_body)

context profile_mono0
begin
   lemma def_homo[simp,code_unfold]: "δ(f x) = (δ x)"
   apply(rule ext, rename_tac "τ",subst foundation22[symmetric])
   apply(case_tac "¬(τ  δ x)", simp add:defined_split, elim disjE)
     apply(erule StrongEq_L_subst2_rev, simp,simp)
    apply(erule StrongEq_L_subst2_rev, simp,simp)
   apply(simp)
   apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="δ x"])
     apply(simp_all add:def_scheme)
   apply(simp add: OclValid_def)
   by(auto simp:foundation13 StrongEq_def false_def true_def defined_def bot_fun_def null_fun_def def_body
           split: if_split_asm)

   lemma def_valid_then_def: "υ(f x) = (δ(f x))"
   apply(rule ext, rename_tac "τ",subst foundation22[symmetric])
   apply(case_tac "¬(τ  δ x)", simp add:defined_split, elim disjE)
     apply(erule StrongEq_L_subst2_rev, simp,simp)
    apply(erule StrongEq_L_subst2_rev, simp,simp)
   apply simp
   apply(simp_all add:def_scheme)
   apply(simp add: OclValid_def valid_def, subst cp_StrongEq)
   apply(subst (2) cp_defined, simp, simp add: cp_defined[symmetric])
   by(auto simp:foundation13 StrongEq_def false_def true_def defined_def bot_fun_def null_fun_def def_body
           split: if_split_asm)
end

subsection‹Property Profiles for Single›

locale profile_single =
   fixes d:: "('𝔄,'a::null)val  '𝔄 Boolean"
   assumes d_strict[simp,code_unfold]: "d invalid = false"
   assumes d_cp0: "d X τ = d (λ _. X τ) τ"
   assumes d_const[simp,code_unfold]: "const X  const (d X)"

subsection‹Property Profiles for Binary Operators›

definition "bin' f g dx dy X Y =
                       (f X Y = (λ τ. if (dx X) τ = true τ  (dy Y) τ = true τ
                                      then g X Y τ
                                      else invalid τ ))"
 
definition "bin f g = bin' f (λX Y τ. g (X τ) (Y τ))"

lemmas [simp,code_unfold] = bin'_def bin_def

locale profile_bin_scheme =
   fixes dx:: "('𝔄,'a::null)val  '𝔄 Boolean"
   fixes dy:: "('𝔄,'b::null)val  '𝔄 Boolean"
   fixes f::"('𝔄,'a::null)val  ('𝔄,'b::null)val  ('𝔄,'c::null)val"
   fixes g
   assumes dx' : "profile_single dx"
   assumes dy' : "profile_single dy"
   assumes dx_dy_homo[simp,code_unfold]: "cp (f X)  
                          cp (λx. f x Y)  
                          f X invalid = invalid 
                          f invalid Y = invalid 
                          (¬ (τ  dx X)  ¬ (τ  dy Y)) 
                          τ  (δ f X Y  (dx X and dy Y))"
   assumes def_scheme''[simplified]: "bin f g dx dy X Y"
   assumes 1: "τ  dx X  τ  dy Y  τ  δ f X Y"
begin
      interpretation dx : profile_single dx by (rule dx')
      interpretation dy : profile_single dy by (rule dy')

      lemma strict1[simp,code_unfold]: " f invalid y = invalid"
      by(rule ext, simp add: def_scheme'' true_def false_def)

      lemma strict2[simp,code_unfold]: " f x invalid = invalid"
      by(rule ext, simp add: def_scheme'' true_def false_def)

      lemma cp0 : "f X Y τ = f (λ _. X τ) (λ _. Y τ) τ"
      by(simp add: def_scheme'' dx.d_cp0[symmetric] dy.d_cp0[symmetric] cp_defined[symmetric])
      
      lemma cp[simp,code_unfold] : " cp P  cp Q  cp (λX. f (P X) (Q X))"
      by(rule cpI2[of "f"], intro allI, rule cp0, simp_all)

      lemma def_homo[simp,code_unfold]: "δ(f x y) = (dx x and dy y)"
         apply(rule ext, rename_tac "τ",subst foundation22[symmetric])
         apply(case_tac "¬(τ  dx x)", simp)
         apply(case_tac "¬(τ  dy y)", simp)
         apply(simp)
         apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="dx x"])
           apply(simp_all)
         apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="dy y"])
           apply(simp_all add: 1 foundation13)
         done

      lemma def_valid_then_def: "υ(f x y) = (δ(f x y))" (* [simp,code_unfold] ? *)
         apply(rule ext, rename_tac "τ") 
         apply(simp_all add: valid_def defined_def def_scheme''
                             true_def false_def invalid_def 
                             null_def null_fun_def null_option_def bot_fun_def)
         by (metis "1" OclValid_def def_scheme'' foundation16 true_def)

      lemma defined_args_valid: "(τ  δ (f x y)) = ((τ  dx x)  (τ  dy y))"
         by(simp add: foundation10')

      lemma const[simp,code_unfold] : 
          assumes C1 :"const X" and C2 : "const Y"
          shows       "const(f X Y)"
      proof -
          have const_g : "const (λτ. g (X τ) (Y τ))" 
                  by(insert C1 C2, auto simp:const_def, metis)
        show ?thesis
        by(simp_all add : def_scheme'' const_ss C1 C2 const_g)
      qed
end


text‹
In our context, we will use Locales as ``Property Profiles'' for OCL operators;
if an operator @{term "f"} is of profile @{term "profile_bin_scheme defined f g"} we know
that it satisfies a number of properties like strict1› or strict2›
\ie{} @{term "f invalid y = invalid"} and @{term "f null y = invalid"}.
Since some of the more advanced Locales come with 10 - 15 theorems, property profiles
represent a major structuring mechanism for the OCL library.
›


locale profile_bin_scheme_defined =
   fixes dy:: "('𝔄,'b::null)val  '𝔄 Boolean"
   fixes f::"('𝔄,'a::null)val  ('𝔄,'b::null)val  ('𝔄,'c::null)val"
   fixes g
   assumes dy : "profile_single dy"
   assumes dy_homo[simp,code_unfold]: "cp (f X)  
                          f X invalid = invalid 
                          ¬ τ  dy Y 
                          τ  δ f X Y  (δ X and dy Y)"
   assumes def_scheme'[simplified]: "bin f g defined dy X Y"
   assumes def_body':  " x y τ. xbot  xnull  (dy y) τ = true τ  g x (y τ)  bot  g x (y τ)  null "
begin
      lemma strict3[simp,code_unfold]: " f null y = invalid"
      by(rule ext, simp add: def_scheme' true_def false_def)
end

sublocale profile_bin_scheme_defined < profile_bin_scheme defined
proof - 
      interpret dy : profile_single dy by (rule dy)
 show "profile_bin_scheme defined dy f g"
 apply(unfold_locales)
      apply(simp)+
     apply(subst cp_defined, simp)
    apply(rule const_defined, simp)
   apply(simp add:defined_split, elim disjE)
     apply(erule StrongEq_L_subst2_rev, simp, simp)+
   apply(simp)
  apply(simp add: def_scheme')
 apply(simp add: defined_def OclValid_def false_def true_def 
              bot_fun_def null_fun_def def_scheme' split: if_split_asm, rule def_body')
 by(simp add: true_def)+
qed

locale profile_bind_d =
   fixes f::"('𝔄,'a::null)val  ('𝔄,'b::null)val  ('𝔄,'c::null)val"
   fixes g
   assumes def_scheme[simplified]: "bin f g defined defined X Y"
   assumes def_body:  " x y. xbot  xnull  ybot  ynull 
                               g x y  bot  g x y  null "
begin
      lemma strict4[simp,code_unfold]: " f x null = invalid"
      by(rule ext, simp add: def_scheme true_def false_def)
end

sublocale profile_bind_d < profile_bin_scheme_defined defined
 apply(unfold_locales)
      apply(simp)+
     apply(subst cp_defined, simp)+
    apply(rule const_defined, simp)+
   apply(simp add:defined_split, elim disjE)
    apply(erule StrongEq_L_subst2_rev, simp, simp)+
  apply(simp add: def_scheme)
 apply(simp add: defined_def OclValid_def false_def true_def bot_fun_def null_fun_def def_scheme)
 apply(rule def_body, simp_all add: true_def false_def split:if_split_asm)
done

locale profile_bind_v =
   fixes f::"('𝔄,'a::null)val  ('𝔄,'b::null)val  ('𝔄,'c::null)val"
   fixes g
   assumes def_scheme[simplified]: "bin f g defined valid X Y"
   assumes def_body:  " x y. xbot  xnull  ybot  g x y  bot  g x y  null"

sublocale profile_bind_v < profile_bin_scheme_defined valid
 apply(unfold_locales)
      apply(simp)
     apply(subst cp_valid, simp)
    apply(rule const_valid, simp)
   apply(simp add:foundation18'')
   apply(erule StrongEq_L_subst2_rev, simp, simp)
  apply(simp add: def_scheme)
 by (metis OclValid_def def_body foundation18')
 
locale profile_binStrongEq_v_v =
   fixes f :: "('𝔄,::null)val  ('𝔄,::null)val  ('𝔄) Boolean"
   assumes def_scheme[simplified]: "bin' f StrongEq valid valid X Y"

sublocale profile_binStrongEq_v_v < profile_bin_scheme valid valid f "λx y. x = y"
 apply(unfold_locales)
      apply(simp)
     apply(subst cp_valid, simp)
    apply (simp add: const_valid)
   apply (metis (hide_lams, mono_tags) OclValid_def def_scheme defined5 defined6 defined_and_I foundation1 foundation10' foundation16' foundation18 foundation21 foundation22 foundation9)
  apply(simp add: def_scheme, subst StrongEq_def, simp)
 by (metis OclValid_def def_scheme defined7 foundation16)

context profile_binStrongEq_v_v
   begin
      lemma idem[simp,code_unfold]: " f null null = true"
      by(rule ext, simp add: def_scheme true_def false_def)

      (* definedness *)
      lemma defargs: "τ  f x y  (τ  υ x)  (τ  υ y)"
         by(simp add: def_scheme OclValid_def true_def invalid_def valid_def bot_option_def
               split: bool.split_asm HOL.if_split_asm)

      lemma defined_args_valid' : "δ (f x y) = (υ x and υ y)"
      by(auto intro!: transform2_rev defined_and_I simp:foundation10 defined_args_valid)

      (* logic and algebraic properties *)
      lemma refl_ext[simp,code_unfold] : "(f x x) = (if (υ x) then true else invalid endif)"
         by(rule ext, simp add: def_scheme OclIf_def)
      
      lemma sym : "τ  (f x y)  τ  (f y x)"  
         apply(case_tac "τ  υ x")
          apply(auto simp: def_scheme OclValid_def)
         by(fold OclValid_def, erule StrongEq_L_sym)

      lemma symmetric : "(f x y) = (f y x)"  
         by(rule ext, rename_tac τ, auto simp: def_scheme StrongEq_sym)
      
      lemma trans : "τ  (f x y)  τ  (f y z)  τ  (f x z)"  
         apply(case_tac "τ  υ x")
          apply(case_tac "τ  υ y")
           apply(auto simp: def_scheme OclValid_def)
         by(fold OclValid_def, auto elim: StrongEq_L_trans)
         
      lemma StrictRefEq_vs_StrongEq: "τ (υ x)  τ (υ y)  (τ  ((f x y)  (x  y)))"
         apply(simp add: def_scheme OclValid_def)
         apply(subst cp_StrongEq[of _ "(x  y)"])
         by simp
         
   end

   
locale profile_binv_v =
   fixes f :: "('𝔄,::null)val  ('𝔄,::null)val  ('𝔄,::null)val"
   fixes g
   assumes def_scheme[simplified]: "bin f g valid valid X Y"
   assumes def_body:  " x y. xbot  ybot  g x y  bot  g x y  null"

sublocale profile_binv_v < profile_bin_scheme valid valid
 apply(unfold_locales)
         apply(simp, subst cp_valid, simp, rule const_valid, simp)+
   apply (metis (hide_lams, mono_tags) OclValid_def def_scheme defined5 defined6 defined_and_I 
         foundation1 foundation10' foundation16' foundation18 foundation21 foundation22 foundation9)
  apply(simp add: def_scheme)
 apply(simp add: defined_def OclValid_def false_def true_def 
              bot_fun_def null_fun_def def_scheme split: if_split_asm, rule def_body)
 by (metis OclValid_def foundation18' true_def)+

end

Theory UML_Boolean

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Boolean.thy --- Library definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

theory  UML_Boolean
imports "../UML_PropertyProfiles"
begin


subsection‹Fundamental Predicates on Basic Types: Strict (Referential) Equality›
text‹
  Here is a first instance of a definition of strict value equality---for
  the special case of the type @{typ "('𝔄)Boolean"}, it is just
  the strict extension of the logical
  equality:
›
overloading StrictRefEq  "StrictRefEq :: [('𝔄)Boolean,('𝔄)Boolean]  ('𝔄)Boolean"
begin
  definition StrictRefEqBoolean[code_unfold] :
    "(x::('𝔄)Boolean)  y  λ τ. if (υ x) τ = true τ  (υ y) τ = true τ
                                  then (x  y)τ
                                  else invalid τ"
end

text‹which implies elementary properties like:›
lemma [simp,code_unfold] : "(true  false) = false"
by(simp add:StrictRefEqBoolean)
lemma [simp,code_unfold] : "(false  true) = false"
by(simp add:StrictRefEqBoolean)

lemma null_non_false [simp,code_unfold]:"(null  false) = false"
 apply(rule ext, simp add: StrictRefEqBoolean StrongEq_def false_def)
 by (metis drop.simps cp_valid false_def is_none_code(2) Option.is_none_def valid4
           bot_option_def null_fun_def null_option_def)

lemma null_non_true [simp,code_unfold]:"(null  true) = false"
 apply(rule ext, simp add: StrictRefEqBoolean StrongEq_def false_def)
 by(simp add: true_def bot_option_def null_fun_def null_option_def)

lemma false_non_null [simp,code_unfold]:"(false  null) = false"
 apply(rule ext, simp add: StrictRefEqBoolean StrongEq_def false_def)
 by(metis drop.simps cp_valid false_def is_none_code(2) Option.is_none_def valid4
          bot_option_def null_fun_def null_option_def )

lemma true_non_null [simp,code_unfold]:"(true  null) = false"
 apply(rule ext, simp add: StrictRefEqBoolean StrongEq_def false_def)
 by(simp add: true_def bot_option_def null_fun_def null_option_def)

text‹With respect to strictness properties and miscelleaneous side-calculi,
strict referential equality behaves on booleans as described in the
@{term "profile_binStrongEq_v_v"}:›
interpretation StrictRefEqBoolean : profile_binStrongEq_v_v "λ x y. (x::('𝔄)Boolean)  y" 
         by unfold_locales (auto simp:StrictRefEqBoolean)
         
text‹In particular, it is strict, cp-preserving and const-preserving. In particular,
it generates the simplifier rules for terms like:›
lemma "(invalid  false) = invalid" by(simp)
lemma "(invalid  true) = invalid"  by(simp)
lemma "(false  invalid) = invalid" by(simp)
lemma "(true  invalid) = invalid"  by(simp)
lemma "((invalid::('𝔄)Boolean)  invalid) = invalid" by(simp)
text‹Thus, the weak equality is \emph{not} reflexive.›



subsection‹Test Statements on Boolean Operations.›
text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›

text‹Elementary computations on Boolean›
Assert "τ  υ(true)"
Assert "τ  δ(false)"
Assert "τ |≠ δ(null)"
Assert "τ |≠ δ(invalid)"
Assert "τ  υ((null::('𝔄)Boolean))"
Assert "τ |≠ υ(invalid)"
Assert "τ  (true and true)"
Assert "τ  (true and true  true)"
Assert "τ  ((null or null)  null)"
Assert "τ  ((null or null)  null)"
Assert "τ  ((true  false)  false)"
Assert "τ  ((invalid  false)  false)"
Assert "τ  ((invalid  false)  invalid)"
Assert "τ  (true <> false)"
Assert "τ  (false <> true)"


end

Theory UML_Void

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Void.thy --- Library definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

theory  UML_Void
imports "../UML_PropertyProfiles"
begin

section‹Basic Type Void: Operations›

(* For technical reasons, the type does not contain to the null-class yet. *)
text ‹This \emph{minimal} OCL type contains only two elements:
@{term "invalid"} and @{term "null"}.
@{term "Void"} could initially be defined as @{typ "unit option option"},
however the cardinal of this type is more than two, so it would have the cost to consider
 Some None› and Some (Some ())› seemingly everywhere.›
 
subsection‹Fundamental Properties on Voids: Strict Equality›

subsubsection‹Definition›

instantiation   Voidbase  :: bot
begin
   definition bot_Void_def: "(bot_class.bot :: Voidbase)  Abs_Voidbase None"

   instance proof show "x:: Voidbase. x  bot"
                  apply(rule_tac x="Abs_Voidbase None" in exI)
                  apply(simp add:bot_Void_def, subst Abs_Voidbase_inject)
                  apply(simp_all add: null_option_def bot_option_def)
                  done
            qed
end

instantiation   Voidbase :: null
begin
   definition null_Void_def: "(null::Voidbase)  Abs_Voidbase  None "

   instance proof show "(null:: Voidbase)  bot"
                  apply(simp add:null_Void_def bot_Void_def, subst Abs_Voidbase_inject)
                  apply(simp_all add: null_option_def bot_option_def)
                  done
            qed
end


text‹The last basic operation belonging to the fundamental infrastructure
of a value-type in OCL is the weak equality, which is defined similar
to the @{typ "('𝔄)Void"}-case as strict extension of the strong equality:›
overloading StrictRefEq  "StrictRefEq :: [('𝔄)Void,('𝔄)Void]  ('𝔄)Boolean"
begin
  definition StrictRefEqVoid[code_unfold] :
    "(x::('𝔄)Void)  y  λ τ. if (υ x) τ = true τ  (υ y) τ = true τ
                               then (x  y) τ
                               else invalid τ"
end

text‹Property proof in terms of @{term "profile_binStrongEq_v_v"}
interpretation   StrictRefEqVoid : profile_binStrongEq_v_v "λ x y. (x::('𝔄)Void)  y" 
       by unfold_locales (auto simp:  StrictRefEqVoid)
 
                                    
subsection‹Basic Void Constants›


subsection‹Validity and Definedness Properties›

lemma  "δ(null::('𝔄)Void) = false" by simp
lemma  "υ(null::('𝔄)Void) = true"  by simp

lemma [simp,code_unfold]: "δ (λ_. Abs_Voidbase None) = false"
apply(simp add:defined_def true_def
               bot_fun_def bot_option_def)
apply(rule ext, simp split:, intro conjI impI)
by(simp add: bot_Void_def)

lemma [simp,code_unfold]: "υ (λ_. Abs_Voidbase None) = false"
apply(simp add:valid_def true_def
               bot_fun_def bot_option_def)
apply(rule ext, simp split:, intro conjI impI)
by(simp add: bot_Void_def)

lemma [simp,code_unfold]: "δ (λ_. Abs_Voidbase None) = false"
apply(simp add:defined_def true_def
               bot_fun_def bot_option_def null_fun_def null_option_def)
apply(rule ext, simp split:, intro conjI impI)
by(simp add: null_Void_def)

lemma [simp,code_unfold]: "υ (λ_. Abs_Voidbase None) = true"
apply(simp add:valid_def true_def
               bot_fun_def bot_option_def)
apply(rule ext, simp split:, intro conjI impI)
by(metis null_Void_def null_is_valid, simp add: true_def)


subsection‹Test Statements›

Assert "τ  ((null::('𝔄)Void)   null)"


end

Theory UML_Integer

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Integer.thy --- Library definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

theory  UML_Integer
imports "../UML_PropertyProfiles"
begin

section‹Basic Type Integer: Operations›

subsection‹Fundamental Predicates on Integers: Strict Equality \label{sec:integer-strict-eq}›

text‹The last basic operation belonging to the fundamental infrastructure
of a value-type in OCL is the weak equality, which is defined similar
to the @{typ "('𝔄)Boolean"}-case as strict extension of the strong equality:›
overloading StrictRefEq  "StrictRefEq :: [('𝔄)Integer,('𝔄)Integer]  ('𝔄)Boolean"
begin
  definition StrictRefEqInteger[code_unfold] :
    "(x::('𝔄)Integer)  y  λ τ. if (υ x) τ = true τ  (υ y) τ = true τ
                                  then (x  y) τ
                                  else invalid τ"
end

text‹Property proof in terms of @{term "profile_binStrongEq_v_v"}
interpretation  StrictRefEqInteger : profile_binStrongEq_v_v "λ x y. (x::('𝔄)Integer)  y" 
         by unfold_locales (auto simp: StrictRefEqInteger)

subsection‹Basic Integer Constants›

text‹Although the remaining part of this library reasons about
integers abstractly, we provide here as example some convenient shortcuts.›

definition OclInt0 ::"('𝔄)Integer" ("𝟬")  where      "𝟬 = (λ _ . 0::int)"
definition OclInt1 ::"('𝔄)Integer" ("𝟭")  where      "𝟭 = (λ _ . 1::int)"
definition OclInt2 ::"('𝔄)Integer" ("𝟮")  where      "𝟮 = (λ _ . 2::int)"
text‹Etc.›
text_raw‹\isatagafp›
definition OclInt3 ::"('𝔄)Integer" ("𝟯")  where      "𝟯 = (λ _ . 3::int)"
definition OclInt4 ::"('𝔄)Integer" ("𝟰")  where      "𝟰 = (λ _ . 4::int)"
definition OclInt5 ::"('𝔄)Integer" ("𝟱")  where      "𝟱 = (λ _ . 5::int)"
definition OclInt6 ::"('𝔄)Integer" ("𝟲")  where      "𝟲 = (λ _ . 6::int)"
definition OclInt7 ::"('𝔄)Integer" ("𝟳")  where      "𝟳 = (λ _ . 7::int)"
definition OclInt8 ::"('𝔄)Integer" ("𝟴")  where      "𝟴 = (λ _ . 8::int)"
definition OclInt9 ::"('𝔄)Integer" ("𝟵")  where      "𝟵 = (λ _ . 9::int)"
definition OclInt10 ::"('𝔄)Integer" ("𝟭𝟬")where      "𝟭𝟬 = (λ _ . 10::int)"

subsection‹Validity and Definedness Properties›

lemma  "δ(null::('𝔄)Integer) = false" by simp
lemma  "υ(null::('𝔄)Integer) = true"  by simp

lemma [simp,code_unfold]: "δ (λ_. n) = true"
by(simp add:defined_def true_def
               bot_fun_def bot_option_def null_fun_def null_option_def)

lemma [simp,code_unfold]: "υ (λ_. n) = true"
by(simp add:valid_def true_def
               bot_fun_def bot_option_def)

(* ecclectic proofs to make examples executable *)
lemma [simp,code_unfold]: "δ 𝟬 = true" by(simp add:OclInt0_def)
lemma [simp,code_unfold]: "υ 𝟬 = true" by(simp add:OclInt0_def)
lemma [simp,code_unfold]: "δ 𝟭 = true" by(simp add:OclInt1_def)
lemma [simp,code_unfold]: "υ 𝟭 = true" by(simp add:OclInt1_def)
lemma [simp,code_unfold]: "δ 𝟮 = true" by(simp add:OclInt2_def)
lemma [simp,code_unfold]: "υ 𝟮 = true" by(simp add:OclInt2_def)
lemma [simp,code_unfold]: "δ 𝟲 = true" by(simp add:OclInt6_def)
lemma [simp,code_unfold]: "υ 𝟲 = true" by(simp add:OclInt6_def)
lemma [simp,code_unfold]: "δ 𝟴 = true" by(simp add:OclInt8_def)
lemma [simp,code_unfold]: "υ 𝟴 = true" by(simp add:OclInt8_def)
lemma [simp,code_unfold]: "δ 𝟵 = true" by(simp add:OclInt9_def)
lemma [simp,code_unfold]: "υ 𝟵 = true" by(simp add:OclInt9_def)

text_raw‹\endisatagafp›

subsection‹Arithmetical Operations›

subsubsection‹Definition›
text‹Here is a common case of a built-in operation on built-in types.
Note that the arguments must be both defined (non-null, non-bot).›
text‹Note that we can not follow the lexis of the OCL Standard for Isabelle
technical reasons; these operators are heavily overloaded in the HOL library
that a further overloading would lead to heavy technical buzz in this
document.
›
definition OclAddInteger ::"('𝔄)Integer  ('𝔄)Integer  ('𝔄)Integer" (infix "+int" 40)
where "x +int y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then x τ + y τ
                       else invalid τ "
interpretation OclAddInteger : profile_bind_d "(+int)" "λ x y. x + y"
         by unfold_locales (auto simp:OclAddInteger_def bot_option_def null_option_def)

  
definition OclMinusInteger ::"('𝔄)Integer  ('𝔄)Integer  ('𝔄)Integer" (infix "-int" 41)
where "x -int y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then x τ - y τ
                       else invalid τ "
interpretation OclMinusInteger : profile_bind_d "(-int)" "λ x y. x - y"
         by   unfold_locales  (auto simp:OclMinusInteger_def bot_option_def null_option_def)

                       
definition OclMultInteger ::"('𝔄)Integer  ('𝔄)Integer  ('𝔄)Integer" (infix "*int" 45)
where "x *int y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then x τ * y τ
                       else invalid τ"
interpretation OclMultInteger : profile_bind_d "OclMultInteger" "λ x y. x * y"
         by   unfold_locales  (auto simp:OclMultInteger_def bot_option_def null_option_def)
          
text‹Here is the special case of division, which is defined as invalid for division
by zero.›
definition OclDivisionInteger ::"('𝔄)Integer  ('𝔄)Integer  ('𝔄)Integer" (infix "divint" 45)
where "x divint y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then if y τ  OclInt0 τ then x τ div y τ else invalid τ 
                       else invalid τ "
(* TODO: special locale setup.*)

definition OclModulusInteger ::"('𝔄)Integer  ('𝔄)Integer  ('𝔄)Integer" (infix "modint" 45)
where "x modint y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then if y τ  OclInt0 τ then x τ mod y τ else invalid τ 
                       else invalid τ "
(* TODO: special locale setup.*)
                       
                       
definition OclLessInteger ::"('𝔄)Integer  ('𝔄)Integer  ('𝔄)Boolean" (infix "<int" 35)
where "x <int y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then x τ < y τ
                       else invalid τ "
interpretation OclLessInteger : profile_bind_d "(<int)" "λ x y. x < y"
         by   unfold_locales  (auto simp:OclLessInteger_def bot_option_def null_option_def)

definition OclLeInteger ::"('𝔄)Integer  ('𝔄)Integer  ('𝔄)Boolean" (infix "int" 35)
where "x int y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then x τ  y τ
                       else invalid τ "
interpretation OclLeInteger : profile_bind_d "(≤int)" "λ x y. x  y"
         by   unfold_locales  (auto simp:OclLeInteger_def bot_option_def null_option_def)

subsubsection‹Basic Properties›

lemma OclAddInteger_commute: "(X +int Y) = (Y +int X)"
  by(rule ext,auto simp:true_def false_def OclAddInteger_def invalid_def
                   split: option.split option.split_asm
                          bool.split bool.split_asm)

subsubsection‹Execution with Invalid or Null or Zero as Argument›

lemma OclAddInteger_zero1[simp,code_unfold] :
"(x +int 𝟬) = (if υ x and not (δ x) then invalid else x endif)"
 proof (rule ext, rename_tac τ, case_tac "(υ x and not (δ x)) τ = true τ")
  fix τ show "(υ x and not (δ x)) τ = true τ 
              (x +int 𝟬) τ = (if υ x and not (δ x) then invalid else x endif) τ"
   apply(subst OclIf_true', simp add: OclValid_def)
  by (metis OclAddInteger_def OclNot_defargs OclValid_def foundation5 foundation9)
 next fix τ
  have A: "τ. (τ  not (υ x and not (δ x))) = (x τ = invalid τ  τ  δ x)"
  by (metis OclNot_not OclOr_def defined5 defined6 defined_not_I foundation11 foundation18'
            foundation6 foundation7 foundation9 invalid_def)
  have B: "τ  δ x  x τ = x τ"
   apply(cases "x τ", metis bot_option_def foundation16)
   apply(rename_tac x', case_tac x', metis bot_option_def foundation16 null_option_def)
  by(simp)
  show "(x +int 𝟬) τ = (if υ x and not (δ x) then invalid else x endif) τ"
    when "τ  not (υ x and not (δ x))"
   apply(insert that, subst OclIf_false', simp, simp add: A, auto simp: OclAddInteger_def OclInt0_def)
     (* *)
     apply(simp add: foundation16'[simplified OclValid_def])
    apply(simp add: B)
  by(simp add: OclValid_def)
qed(metis OclValid_def defined5 defined6 defined_and_I defined_not_I foundation9)

lemma OclAddInteger_zero2[simp,code_unfold] :
"(𝟬 +int x) = (if υ x and not (δ x) then invalid else x endif)"
by(subst OclAddInteger_commute, simp)

(* TODO Basic proproperties for multiplication, division, modulus. *)



subsection‹Test Statements›
text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›

Assert "τ  ( 𝟵 int 𝟭𝟬 )"
Assert "τ  (( 𝟰 +int 𝟰 ) int 𝟭𝟬 )"
Assert "τ |≠ (( 𝟰 +int ( 𝟰 +int 𝟰 )) <int 𝟭𝟬 )"
Assert "τ  not (υ (null +int 𝟭)) "
Assert "τ  (((𝟵 *int 𝟰) divint 𝟭𝟬) int  𝟰) "
Assert "τ  not (δ (𝟭 divint 𝟬)) "
Assert "τ  not (υ (𝟭 divint 𝟬)) "



lemma integer_non_null [simp]: "((λ_. n)  (null::('𝔄)Integer)) = false"
by(rule ext,auto simp: StrictRefEqInteger valid_def
                         bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def)

lemma null_non_integer [simp]: "((null::('𝔄)Integer)  (λ_. n)) = false"
by(rule ext,auto simp: StrictRefEqInteger valid_def
                         bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def)

lemma OclInt0_non_null [simp,code_unfold]: "(𝟬  null) = false" by(simp add: OclInt0_def)
lemma null_non_OclInt0 [simp,code_unfold]: "(null  𝟬) = false" by(simp add: OclInt0_def)
lemma OclInt1_non_null [simp,code_unfold]: "(𝟭  null) = false" by(simp add: OclInt1_def)
lemma null_non_OclInt1 [simp,code_unfold]: "(null  𝟭) = false" by(simp add: OclInt1_def)
lemma OclInt2_non_null [simp,code_unfold]: "(𝟮  null) = false" by(simp add: OclInt2_def)
lemma null_non_OclInt2 [simp,code_unfold]: "(null  𝟮) = false" by(simp add: OclInt2_def)
lemma OclInt6_non_null [simp,code_unfold]: "(𝟲  null) = false" by(simp add: OclInt6_def)
lemma null_non_OclInt6 [simp,code_unfold]: "(null  𝟲) = false" by(simp add: OclInt6_def)
lemma OclInt8_non_null [simp,code_unfold]: "(𝟴  null) = false" by(simp add: OclInt8_def)
lemma null_non_OclInt8 [simp,code_unfold]: "(null  𝟴) = false" by(simp add: OclInt8_def)
lemma OclInt9_non_null [simp,code_unfold]: "(𝟵  null) = false" by(simp add: OclInt9_def)
lemma null_non_OclInt9 [simp,code_unfold]: "(null  𝟵) = false" by(simp add: OclInt9_def)


text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›


text‹Elementary computations on Integer›

Assert "τ  ((𝟬 <int 𝟮) and (𝟬 <int 𝟭))"

Assert "τ  𝟭 <> 𝟮"
Assert "τ  𝟮 <> 𝟭"
Assert "τ  𝟮  𝟮"

Assert "τ  υ 𝟰"
Assert "τ  δ 𝟰"
Assert "τ  υ (null::('𝔄)Integer)"
Assert "τ  (invalid  invalid)"
Assert "τ  (null  null)"
Assert "τ  (𝟰  𝟰)"
Assert "τ |≠ (𝟵  𝟭𝟬)"
Assert "τ |≠ (invalid  𝟭𝟬)"
Assert "τ |≠ (null  𝟭𝟬)"
Assert "τ |≠ (invalid  (invalid::('𝔄)Integer))"   (* Without typeconstraint not executable.*)
Assert "τ |≠ υ (invalid  (invalid::('𝔄)Integer))" (* Without typeconstraint not executable.*)
Assert "τ |≠ (invalid <> (invalid::('𝔄)Integer))"   (* Without typeconstraint not executable.*)
Assert "τ |≠ υ (invalid <> (invalid::('𝔄)Integer))" (* Without typeconstraint not executable.*)
Assert "τ  (null  (null::('𝔄)Integer) )" (* Without typeconstraint not executable.*)
Assert "τ  (null  (null::('𝔄)Integer) )" (* Without typeconstraint not executable.*)
Assert "τ  (𝟰  𝟰)"
Assert "τ |≠ (𝟰 <> 𝟰)"
Assert "τ |≠ (𝟰  𝟭𝟬)"
Assert "τ  (𝟰 <> 𝟭𝟬)"
Assert "τ |≠ (𝟬 <int null)"
Assert "τ |≠ (δ (𝟬 <int null))"


end

Theory UML_Real

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Real.thy --- Library definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

theory  UML_Real
imports "../UML_PropertyProfiles"
begin

section‹Basic Type Real: Operations›

subsection‹Fundamental Predicates on Reals: Strict Equality \label{sec:real-strict-eq}›

text‹The last basic operation belonging to the fundamental infrastructure
of a value-type in OCL is the weak equality, which is defined similar
to the @{typ "('𝔄)Boolean"}-case as strict extension of the strong equality:›
overloading StrictRefEq  "StrictRefEq :: [('𝔄)Real,('𝔄)Real]  ('𝔄)Boolean"
begin
  definition StrictRefEqReal [code_unfold] :
    "(x::('𝔄)Real)  y  λ τ. if (υ x) τ = true τ  (υ y) τ = true τ
                                  then (x  y) τ
                                  else invalid τ"
end

text‹Property proof in terms of @{term "profile_binStrongEq_v_v"}
interpretation StrictRefEqReal : profile_binStrongEq_v_v "λ x y. (x::('𝔄)Real)  y" 
         by unfold_locales (auto simp: StrictRefEqReal)

subsection‹Basic Real Constants›

text‹Although the remaining part of this library reasons about
reals abstractly, we provide here as example some convenient shortcuts.›

definition OclReal0 ::"('𝔄)Real" ("𝟬.𝟬")   where      "𝟬.𝟬 =  (λ _ . 0::real)"
definition OclReal1 ::"('𝔄)Real" ("𝟭.𝟬")   where      "𝟭.𝟬 = (λ _ . 1::real)"
definition OclReal2 ::"('𝔄)Real" ("𝟮.𝟬")   where      "𝟮.𝟬 = (λ _ . 2::real)"
text‹Etc.›
text_raw‹\isatagafp›
definition OclReal3 ::"('𝔄)Real" ("𝟯.𝟬")   where      "𝟯.𝟬 = (λ _ . 3::real)"
definition OclReal4 ::"('𝔄)Real" ("𝟰.𝟬")   where      "𝟰.𝟬 = (λ _ . 4::real)"
definition OclReal5 ::"('𝔄)Real" ("𝟱.𝟬")   where      "𝟱.𝟬 = (λ _ . 5::real)"
definition OclReal6 ::"('𝔄)Real" ("𝟲.𝟬")   where      "𝟲.𝟬 = (λ _ . 6::real)" 
definition OclReal7 ::"('𝔄)Real" ("𝟳.𝟬")   where      "𝟳.𝟬 = (λ _ . 7::real)"
definition OclReal8 ::"('𝔄)Real" ("𝟴.𝟬")   where      "𝟴.𝟬 = (λ _ . 8::real)"
definition OclReal9 ::"('𝔄)Real" ("𝟵.𝟬")   where      "𝟵.𝟬 = (λ _ . 9::real)"
definition OclReal10 ::"('𝔄)Real" ("𝟭𝟬.𝟬") where      "𝟭𝟬.𝟬 = (λ _ . 10::real)"
definition OclRealpi ::"('𝔄)Real" ("π")    where      "π = (λ _ . pi)"

subsection‹Validity and Definedness Properties›

lemma  "δ(null::('𝔄)Real) = false" by simp
lemma  "υ(null::('𝔄)Real) = true"  by simp

lemma [simp,code_unfold]: "δ (λ_. n) = true"
by(simp add:defined_def true_def
               bot_fun_def bot_option_def null_fun_def null_option_def)

lemma [simp,code_unfold]: "υ (λ_. n) = true"
by(simp add:valid_def true_def
               bot_fun_def bot_option_def)

(* ecclectic proofs to make examples executable *)
lemma [simp,code_unfold]: "δ 𝟬.𝟬 = true" by(simp add:OclReal0_def)
lemma [simp,code_unfold]: "υ 𝟬.𝟬 = true" by(simp add:OclReal0_def)
lemma [simp,code_unfold]: "δ 𝟭.𝟬 = true" by(simp add:OclReal1_def)
lemma [simp,code_unfold]: "υ 𝟭.𝟬 = true" by(simp add:OclReal1_def)
lemma [simp,code_unfold]: "δ 𝟮.𝟬 = true" by(simp add:OclReal2_def)
lemma [simp,code_unfold]: "υ 𝟮.𝟬 = true" by(simp add:OclReal2_def)
lemma [simp,code_unfold]: "δ 𝟲.𝟬 = true" by(simp add:OclReal6_def)
lemma [simp,code_unfold]: "υ 𝟲.𝟬 = true" by(simp add:OclReal6_def)
lemma [simp,code_unfold]: "δ 𝟴.𝟬 = true" by(simp add:OclReal8_def)
lemma [simp,code_unfold]: "υ 𝟴.𝟬 = true" by(simp add:OclReal8_def)
lemma [simp,code_unfold]: "δ 𝟵.𝟬 = true" by(simp add:OclReal9_def)
lemma [simp,code_unfold]: "υ 𝟵.𝟬 = true" by(simp add:OclReal9_def)
text_raw‹\endisatagafp›

subsection‹Arithmetical Operations›

subsubsection‹Definition›
text‹Here is a common case of a built-in operation on built-in types.
Note that the arguments must be both defined (non-null, non-bot).›
text‹Note that we can not follow the lexis of the OCL Standard for Isabelle
technical reasons; these operators are heavily overloaded in the HOL library
that a further overloading would lead to heavy technical buzz in this
document.
›
definition OclAddReal ::"('𝔄)Real  ('𝔄)Real  ('𝔄)Real" (infix "+real" 40)
where "x +real y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then x τ + y τ
                       else invalid τ "
interpretation OclAddReal : profile_bind_d "(+real)" "λ x y. x + y"
         by unfold_locales (auto simp:OclAddReal_def bot_option_def null_option_def)


definition OclMinusReal ::"('𝔄)Real  ('𝔄)Real  ('𝔄)Real" (infix "-real" 41)
where "x -real y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then x τ - y τ
                       else invalid τ "
interpretation OclMinusReal : profile_bind_d "(-real)" "λ x y. x - y"
         by   unfold_locales  (auto simp:OclMinusReal_def bot_option_def null_option_def)


definition OclMultReal ::"('𝔄)Real  ('𝔄)Real  ('𝔄)Real" (infix "*real" 45)
where "x *real y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then x τ * y τ
                       else invalid τ"
interpretation OclMultReal : profile_bind_d "OclMultReal" "λ x y. x * y"
         by   unfold_locales  (auto simp:OclMultReal_def bot_option_def null_option_def)
          
text‹Here is the special case of division, which is defined as invalid for division
by zero.›
definition OclDivisionReal ::"('𝔄)Real  ('𝔄)Real  ('𝔄)Real" (infix "divreal" 45)
where "x divreal y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then if y τ  OclReal0 τ then x τ / y τ else invalid τ 
                       else invalid τ "
(* TODO: special locale setup.*)

definition "mod_float a b = a - real_of_int (floor (a / b)) * b"
definition OclModulusReal ::"('𝔄)Real  ('𝔄)Real  ('𝔄)Real" (infix "modreal" 45)
where "x modreal y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then if y τ  OclReal0 τ then mod_float x τ y τ else invalid τ 
                       else invalid τ "
(* TODO: special locale setup.*)


definition OclLessReal ::"('𝔄)Real  ('𝔄)Real  ('𝔄)Boolean" (infix "<real" 35)
where "x <real y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then x τ < y τ
                       else invalid τ "
interpretation OclLessReal : profile_bind_d "(<real)" "λ x y. x < y"
         by   unfold_locales  (auto simp:OclLessReal_def bot_option_def null_option_def)

definition OclLeReal ::"('𝔄)Real  ('𝔄)Real  ('𝔄)Boolean" (infix "real" 35)
where "x real y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then x τ  y τ
                       else invalid τ "
interpretation OclLeReal : profile_bind_d "(≤real)" "λ x y. x  y"
         by   unfold_locales  (auto simp:OclLeReal_def bot_option_def null_option_def)

subsubsection‹Basic Properties›

lemma OclAddReal_commute: "(X +real Y) = (Y +real X)"
  by(rule ext,auto simp:true_def false_def OclAddReal_def invalid_def
                   split: option.split option.split_asm
                          bool.split bool.split_asm)

subsubsection‹Execution with Invalid or Null or Zero as Argument›

lemma OclAddReal_zero1[simp,code_unfold] :
"(x +real 𝟬.𝟬) = (if υ x and not (δ x) then invalid else x endif)"
 proof (rule ext, rename_tac τ, case_tac "(υ x and not (δ x)) τ = true τ")
  fix τ show "(υ x and not (δ x)) τ = true τ 
              (x +real 𝟬.𝟬) τ = (if υ x and not (δ x) then invalid else x endif) τ"
   apply(subst OclIf_true', simp add: OclValid_def)
  by (metis OclAddReal_def OclNot_defargs OclValid_def foundation5 foundation9)
 next fix τ
  have A: "τ. (τ  not (υ x and not (δ x))) = (x τ = invalid τ  τ  δ x)"
  by (metis OclNot_not OclOr_def defined5 defined6 defined_not_I foundation11 foundation18'
            foundation6 foundation7 foundation9 invalid_def)
  have B: "τ  δ x  x τ = x τ"
   apply(cases "x τ", metis bot_option_def foundation16)
   apply(rename_tac x', case_tac x', metis bot_option_def foundation16 null_option_def)
  by(simp)
  show "(x +real 𝟬.𝟬) τ = (if υ x and not (δ x) then invalid else x endif) τ"
    when "τ  not (υ x and not (δ x))"
   apply(insert that, subst OclIf_false', simp, simp add: A, auto simp: OclAddReal_def OclReal0_def)
     (* *)
     apply(simp add: foundation16'[simplified OclValid_def])
    apply(simp add: B)
  by(simp add: OclValid_def)
qed(metis OclValid_def defined5 defined6 defined_and_I defined_not_I foundation9)

lemma OclAddReal_zero2[simp,code_unfold] :
"(𝟬.𝟬 +real x) = (if υ x and not (δ x) then invalid else x endif)"
by(subst OclAddReal_commute, simp)

(* TODO Basic proproperties for multiplication, division, modulus. *)



subsection‹Test Statements›
text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›

Assert "τ  ( 𝟵.𝟬 real 𝟭𝟬.𝟬 )"
Assert "τ  (( 𝟰.𝟬 +real 𝟰.𝟬 ) real 𝟭𝟬.𝟬 )"
Assert "τ |≠ (( 𝟰.𝟬 +real ( 𝟰.𝟬 +real 𝟰.𝟬 )) <real 𝟭𝟬.𝟬 )"
Assert "τ  not (υ (null +real 𝟭.𝟬)) "
Assert "τ  (((𝟵.𝟬 *real 𝟰.𝟬) divreal 𝟭𝟬.𝟬) real  𝟰.𝟬) "
Assert "τ  not (δ (𝟭.𝟬 divreal 𝟬.𝟬)) "
Assert "τ  not (υ (𝟭.𝟬 divreal 𝟬.𝟬)) "



lemma real_non_null [simp]: "((λ_. n)  (null::('𝔄)Real)) = false"
by(rule ext,auto simp: StrictRefEqReal valid_def
                         bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def)

lemma null_non_real [simp]: "((null::('𝔄)Real)  (λ_. n)) = false"
by(rule ext,auto simp: StrictRefEqReal valid_def
                         bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def)

lemma OclReal0_non_null [simp,code_unfold]: "(𝟬.𝟬  null) = false" by(simp add: OclReal0_def)
lemma null_non_OclReal0 [simp,code_unfold]: "(null  𝟬.𝟬) = false" by(simp add: OclReal0_def)
lemma OclReal1_non_null [simp,code_unfold]: "(𝟭.𝟬  null) = false" by(simp add: OclReal1_def)
lemma null_non_OclReal1 [simp,code_unfold]: "(null  𝟭.𝟬) = false" by(simp add: OclReal1_def)
lemma OclReal2_non_null [simp,code_unfold]: "(𝟮.𝟬  null) = false" by(simp add: OclReal2_def)
lemma null_non_OclReal2 [simp,code_unfold]: "(null  𝟮.𝟬) = false" by(simp add: OclReal2_def)
lemma OclReal6_non_null [simp,code_unfold]: "(𝟲.𝟬  null) = false" by(simp add: OclReal6_def)
lemma null_non_OclReal6 [simp,code_unfold]: "(null  𝟲.𝟬) = false" by(simp add: OclReal6_def)
lemma OclReal8_non_null [simp,code_unfold]: "(𝟴.𝟬  null) = false" by(simp add: OclReal8_def)
lemma null_non_OclReal8 [simp,code_unfold]: "(null  𝟴.𝟬) = false" by(simp add: OclReal8_def)
lemma OclReal9_non_null [simp,code_unfold]: "(𝟵.𝟬  null) = false" by(simp add: OclReal9_def)
lemma null_non_OclReal9 [simp,code_unfold]: "(null  𝟵.𝟬) = false" by(simp add: OclReal9_def)


text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›


text‹Elementary computations on Real›

Assert "τ  𝟭.𝟬 <> 𝟮.𝟬"
Assert "τ  𝟮.𝟬 <> 𝟭.𝟬"
Assert "τ  𝟮.𝟬  𝟮.𝟬"

Assert "τ  υ 𝟰.𝟬"
Assert "τ  δ 𝟰.𝟬"
Assert "τ  υ (null::('𝔄)Real)"
Assert "τ  (invalid  invalid)"
Assert "τ  (null  null)"
Assert "τ  (𝟰.𝟬  𝟰.𝟬)"
Assert "τ |≠ (𝟵.𝟬  𝟭𝟬.𝟬)"
Assert "τ |≠ (invalid  𝟭𝟬.𝟬)"
Assert "τ |≠ (null  𝟭𝟬.𝟬)"
Assert "τ |≠ (invalid  (invalid::('𝔄)Real))" (* Without typeconstraint not executable.*)
Assert "τ |≠ υ (invalid  (invalid::('𝔄)Real))" (* Without typeconstraint not executable.*)
Assert "τ |≠ (invalid <> (invalid::('𝔄)Real))" (* Without typeconstraint not executable.*)
Assert "τ |≠ υ (invalid <> (invalid::('𝔄)Real))" (* Without typeconstraint not executable.*)
Assert "τ  (null  (null::('𝔄)Real) )" (* Without typeconstraint not executable.*)
Assert "τ  (null  (null::('𝔄)Real) )" (* Without typeconstraint not executable.*)
Assert "τ  (𝟰.𝟬  𝟰.𝟬)"
Assert "τ |≠ (𝟰.𝟬 <> 𝟰.𝟬)"
Assert "τ |≠ (𝟰.𝟬  𝟭𝟬.𝟬)"
Assert "τ  (𝟰.𝟬 <> 𝟭𝟬.𝟬)"
Assert "τ |≠ (𝟬.𝟬 <real null)"
Assert "τ |≠ (δ (𝟬.𝟬 <real null))"


end

Theory UML_String

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_String.thy --- Library definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

theory  UML_String
imports "../UML_PropertyProfiles"
begin

section‹Basic Type String: Operations›

subsection‹Fundamental Properties on Strings: Strict Equality \label{sec:string-strict-eq}›

text‹The last basic operation belonging to the fundamental infrastructure
of a value-type in OCL is the weak equality, which is defined similar
to the @{typ "('𝔄)Boolean"}-case as strict extension of the strong equality:›
overloading StrictRefEq  "StrictRefEq :: [('𝔄)String,('𝔄)String]  ('𝔄)Boolean"
begin
  definition StrictRefEqString[code_unfold] :
    "(x::('𝔄)String)  y  λ τ. if (υ x) τ = true τ  (υ y) τ = true τ
                                  then (x  y) τ
                                  else invalid τ"
end

text‹Property proof in terms of @{term "profile_binStrongEq_v_v"}
interpretation  StrictRefEqString : profile_binStrongEq_v_v "λ x y. (x::('𝔄)String)  y" 
         by unfold_locales (auto simp: StrictRefEqString)
 
subsection‹Basic String Constants›

text‹Although the remaining part of this library reasons about
integers abstractly, we provide here as example some convenient shortcuts.›

definition OclStringa ::"('𝔄)String" ("𝖺")    where      "𝖺 = (λ _ . ''a'')"
definition OclStringb ::"('𝔄)String" ("𝖻")    where      "𝖻 = (λ _ . ''b'')"
definition OclStringc ::"('𝔄)String" ("𝖼")    where      "𝖼 = (λ _ . ''c'')"
text‹Etc.›
text_raw‹\isatagafp›

subsection‹Validity and Definedness Properties›

lemma  "δ(null::('𝔄)String) = false" by simp
lemma  "υ(null::('𝔄)String) = true"  by simp

lemma [simp,code_unfold]: "δ (λ_. n) = true"
by(simp add:defined_def true_def
               bot_fun_def bot_option_def null_fun_def null_option_def)

lemma [simp,code_unfold]: "υ (λ_. n) = true"
by(simp add:valid_def true_def
               bot_fun_def bot_option_def)

(* ecclectic proofs to make examples executable *)
lemma [simp,code_unfold]: "δ 𝖺 = true" by(simp add:OclStringa_def)
lemma [simp,code_unfold]: "υ 𝖺 = true" by(simp add:OclStringa_def)
text_raw‹\endisatagafp›

subsection‹String Operations›

subsubsection‹Definition›
text‹Here is a common case of a built-in operation on built-in types.
Note that the arguments must be both defined (non-null, non-bot).›
text‹Note that we can not follow the lexis of the OCL Standard for Isabelle
technical reasons; these operators are heavily overloaded in the HOL library
that a further overloading would lead to heavy technical buzz in this
document.
›
definition OclAddString ::"('𝔄)String  ('𝔄)String  ('𝔄)String" (infix "+string" 40)
where "x +string y  λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                       then concat [x τ, y τ]
                       else invalid τ "
interpretation OclAddString : profile_bind_d "(+string)" "λ x y. concat [x, y]"
         by unfold_locales (auto simp:OclAddString_def bot_option_def null_option_def)
         
(* TODO : size(), concat, substring(s:string) toInteger, toReal, at(i:Integer), characters() etc. *)


subsubsection‹Basic Properties›

lemma OclAddString_not_commute: "X Y. (X +string Y)  (Y +string X)"
  apply(rule_tac x = "λ_. ''b''" in exI)
  apply(rule_tac x = "λ_. ''a''" in exI)
  apply(simp_all add:OclAddString_def)
  by(auto, drule fun_cong, auto)


subsection‹Test Statements›
text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›
(*
Assert "τ ⊨ ( 𝟵 ≤string 𝟭𝟬 )"
Assert "τ ⊨ (( 𝟰 +string 𝟰 ) ≤string 𝟭𝟬 )"
Assert "τ |≠ (( 𝟰 +string ( 𝟰 +string 𝟰 )) <string 𝟭𝟬 )"
Assert "τ ⊨ not (υ (null +string 𝟭)) "
*)

text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›


text‹Elementary computations on String›

Assert "τ  𝖺 <> 𝖻"
Assert "τ  𝖻 <> 𝖺"
Assert "τ  𝖻  𝖻"

Assert "τ  υ 𝖺"
Assert "τ  δ 𝖺"
Assert "τ  υ (null::('𝔄)String)"
Assert "τ  (invalid  invalid)"
Assert "τ  (null  null)"
Assert "τ  (𝖺  𝖺)"
Assert "τ |≠ (𝖺  𝖻)"
Assert "τ |≠ (invalid  𝖻)"
Assert "τ |≠ (null  𝖻)"
Assert "τ |≠ (invalid  (invalid::('𝔄)String))" (* Without typeconstraint not executable.*)
Assert "τ |≠ υ (invalid  (invalid::('𝔄)String))" (* Without typeconstraint not executable.*)
Assert "τ |≠ (invalid <> (invalid::('𝔄)String))" (* Without typeconstraint not executable.*)
Assert "τ |≠ υ (invalid <> (invalid::('𝔄)String))" (* Without typeconstraint not executable.*)
Assert "τ  (null  (null::('𝔄)String) )" (* Without typeconstraint not executable.*)
Assert "τ  (null  (null::('𝔄)String) )" (* Without typeconstraint not executable.*)
Assert "τ  (𝖻  𝖻)"
Assert "τ |≠ (𝖻 <> 𝖻)"
Assert "τ |≠ (𝖻  𝖼)"
Assert "τ  (𝖻 <> 𝖼)"
(*Assert "τ |≠ (𝟬 <string null)"
Assert "τ |≠ (δ (𝟬 <string null))"
*)

end

Theory UML_Pair

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Pair.thy --- Library definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

theory  UML_Pair
imports "../UML_PropertyProfiles"
begin

section‹Collection Type Pairs: Operations \label{sec:collection_pairs}›

text‹The OCL standard provides the concept of \emph{Tuples}, \ie{} a family of record-types
with projection functions. In FeatherWeight OCL,  only the theory of a special case is
developped, namely the type of Pairs, which is, however, sufficient for all applications
since it can be used to mimick all tuples. In particular, it can be used to express operations
with multiple arguments, roles of n-ary associations, ...›

subsection‹Semantic Properties of the Type Constructor›

lemma A[simp]:"Rep_Pairbase x  None  Rep_Pairbase x  null  (fst Rep_Pairbase x)  bot" 
by(insert Rep_Pairbase[of x],auto simp:null_option_def bot_option_def)

lemma A'[simp]:" x  bot   x  null  (fst Rep_Pairbase x)  bot" 
apply(insert Rep_Pairbase[of x], simp add: bot_Pairbase_def null_Pairbase_def)
apply(auto simp:null_option_def bot_option_def)
apply(erule contrapos_np[of "x = Abs_Pairbase None"])
apply(subst Rep_Pairbase_inject[symmetric], simp)
apply(subst Pairbase.Abs_Pairbase_inverse, simp_all,simp add: bot_option_def)
apply(erule contrapos_np[of "x = Abs_Pairbase None"])
apply(subst Rep_Pairbase_inject[symmetric], simp)
apply(subst Pairbase.Abs_Pairbase_inverse, simp_all,simp add: null_option_def bot_option_def)
done

lemma B[simp]:"Rep_Pairbase x  None  Rep_Pairbase x  null  (snd Rep_Pairbase x)  bot" 
by(insert Rep_Pairbase[of x],auto simp:null_option_def bot_option_def)

lemma B'[simp]:"x  bot  x  null  (snd Rep_Pairbase x)  bot" 
apply(insert Rep_Pairbase[of x], simp add: bot_Pairbase_def null_Pairbase_def)
apply(auto simp:null_option_def bot_option_def)
apply(erule contrapos_np[of "x = Abs_Pairbase None"])
apply(subst Rep_Pairbase_inject[symmetric], simp)
apply(subst Pairbase.Abs_Pairbase_inverse, simp_all,simp add: bot_option_def)
apply(erule contrapos_np[of "x = Abs_Pairbase None"])
apply(subst Rep_Pairbase_inject[symmetric], simp)
apply(subst Pairbase.Abs_Pairbase_inverse, simp_all,simp add: null_option_def bot_option_def)
done

subsection‹Fundamental Properties of Strict Equality \label{sec:pair-strict-eq}›

text‹After the part of foundational operations on sets, we detail here equality on sets.
Strong equality is inherited from the OCL core, but we have to consider
the case of the strict equality. We decide to overload strict equality in the
same way we do for other value's in OCL:›

overloading
  StrictRefEq  "StrictRefEq :: [('𝔄,::null,::null)Pair,('𝔄,::null,::null)Pair]  ('𝔄)Boolean"
begin
  definition StrictRefEqPair :
    "((x::('𝔄,::null,::null)Pair)  y)  (λ τ. if (υ x) τ = true τ  (υ y) τ = true τ
                                                     then (x  y)τ
                                                     else invalid τ)"
end

text‹Property proof in terms of @{term "profile_binStrongEq_v_v"}
interpretation  StrictRefEqPair : profile_binStrongEq_v_v "λ x y. (x::('𝔄,::null,::null)Pair)  y" 
                by unfold_locales (auto simp:  StrictRefEqPair)
 
subsection‹Standard Operations Definitions›

text‹This part provides a collection of operators for the Pair type.›

subsubsection‹Definition: Pair Constructor›

definition OclPair::"('𝔄, ) val 
                     ('𝔄, ) val 
                     ('𝔄,::null,::null) Pair"  ("Pair{(_),(_)}")
where     "Pair{X,Y}  (λ τ. if (υ X) τ = true τ  (υ Y) τ = true τ
                              then Abs_Pairbase (X τ, Y τ)
                              else invalid τ)"

interpretation OclPair : profile_binv_v  
               OclPair "λ x y. Abs_Pairbase (x, y)"                             
               apply(unfold_locales, auto simp:  OclPair_def bot_Pairbase_def null_Pairbase_def)
               by(auto simp: Abs_Pairbase_inject null_option_def bot_option_def)
             

subsubsection‹Definition: First›

definition OclFirst::" ('𝔄,::null,::null) Pair  ('𝔄, ) val"  (" _ .First'(')")
where     "X .First()  (λ τ. if (δ X) τ = true τ
                              then fst Rep_Pairbase (X τ)
                              else invalid τ)"


interpretation OclFirst : profile_monod OclFirst "λx.  fst Rep_Pairbase (x)"
                          by unfold_locales (auto simp:  OclFirst_def)

subsubsection‹Definition: Second›
                              
definition OclSecond::" ('𝔄,::null,::null) Pair  ('𝔄, ) val"  ("_ .Second'(')")
where     "X .Second()  (λ τ. if (δ X) τ = true τ
                               then snd Rep_Pairbase (X τ)
                               else invalid τ)"

interpretation OclSecond : profile_monod OclSecond "λx.  snd Rep_Pairbase (x)"
                           by unfold_locales  (auto simp:  OclSecond_def)
                           
subsection‹Logical Properties›

lemma 1 : "τ  υ Y  τ  Pair{X,Y} .First()  X"
apply(case_tac "¬(τ  υ X)")
apply(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, 
                                       THEN StrongEq_L_subst2_rev]],simp_all add:foundation18')
apply(auto simp: OclValid_def valid_def defined_def StrongEq_def OclFirst_def OclPair_def
                true_def false_def invalid_def bot_fun_def null_fun_def)
apply(auto simp: Abs_Pairbase_inject null_option_def bot_option_def bot_Pairbase_def null_Pairbase_def)
by(simp add: Abs_Pairbase_inverse)

lemma 2 : "τ  υ X  τ  Pair{X,Y} .Second()  Y" 
apply(case_tac "¬(τ  υ Y)")
apply(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, 
                                       THEN StrongEq_L_subst2_rev]],simp_all add:foundation18')
apply(auto simp: OclValid_def valid_def defined_def StrongEq_def OclSecond_def OclPair_def
                true_def false_def invalid_def bot_fun_def null_fun_def)
apply(auto simp: Abs_Pairbase_inject null_option_def bot_option_def bot_Pairbase_def null_Pairbase_def)
by(simp add: Abs_Pairbase_inverse)

subsection‹Algebraic Execution Properties›

lemma proj1_exec [simp, code_unfold] : "Pair{X,Y} .First() = (if (υ Y) then X else invalid endif)"
apply(rule ext, rename_tac "τ", simp add: foundation22[symmetric])
apply(case_tac "¬(τ  υ Y)")
apply(erule foundation7'[THEN iffD2, 
                         THEN foundation15[THEN iffD2, 
                                           THEN StrongEq_L_subst2_rev]],simp_all)
apply(subgoal_tac "τ  υ Y")
apply(erule foundation13[THEN iffD2, THEN StrongEq_L_subst2_rev], simp_all)
by(erule 1)

lemma proj2_exec [simp, code_unfold] : "Pair{X,Y} .Second() = (if (υ X) then Y else invalid endif)"
apply(rule ext, rename_tac "τ", simp add: foundation22[symmetric])
apply(case_tac "¬(τ  υ X)")
apply(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, 
                                  THEN StrongEq_L_subst2_rev]],simp_all)
apply(subgoal_tac "τ  υ X")
apply(erule foundation13[THEN iffD2, THEN StrongEq_L_subst2_rev], simp_all)
by(erule 2)

(* < *)

subsection‹Test Statements›
(*
Assert   "(τ ⊨ (Pair{λ_. ⌊⌊x⌋⌋,λ_. ⌊⌊x⌋⌋} ≐ Pair{λ_. ⌊⌊x⌋⌋,λ_. ⌊⌊x⌋⌋}))"
Assert   "(τ ⊨ (Pair{λ_. ⌊x⌋,λ_. ⌊x⌋} ≐ Pair{λ_. ⌊x⌋,λ_. ⌊x⌋}))"
*)

instantiation Pairbase  :: (equal,equal)equal
begin
  definition "HOL.equal k l   (k::('a::equal,'b::equal)Pairbase) =  l"
  instance   by standard (rule equal_Pairbase_def)
end

lemma equal_Pairbase_code [code]:
  "HOL.equal k (l::('a::{equal,null},'b::{equal,null})Pairbase)  Rep_Pairbase k = Rep_Pairbase l"
  by (auto simp add: equal Pairbase.Rep_Pairbase_inject)

Assert "τ  invalid .First()  invalid "
Assert "τ  null .First()  invalid "
Assert "τ  null .Second()  invalid .Second() "
Assert "τ  Pair{invalid, true}  invalid "
Assert "τ  υ(Pair{null, true}.First())"
Assert "τ  (Pair{null, true}).First()  null "
Assert "τ  (Pair{null, Pair{true,invalid}}).First()  invalid "


(*
Assert   "¬ (τ ⊨ (Pair{𝟭,𝟮} ≐ Pair{𝟮,𝟭}))"
*)

(* > *)

end

Theory UML_Bag

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Bag.thy --- Library definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)


theory  UML_Bag
imports "../basic_types/UML_Void"
        "../basic_types/UML_Boolean"
        "../basic_types/UML_Integer"
        "../basic_types/UML_String"
        "../basic_types/UML_Real"
begin

no_notation None ("")
section‹Collection Type Bag: Operations›

definition "Rep_Bag_base' x = {(x0, y). y < Rep_Bagbase x x0 }"
definition "Rep_Bag_base x τ = {(x0, y). y < Rep_Bagbase (x τ) x0 }"
definition "Rep_Set_base x τ = fst ` {(x0, y). y < Rep_Bagbase (x τ) x0 }"

definition ApproxEq (infixl "" 30)
where     "X  Y   λ τ. Rep_Set_base X τ = Rep_Set_base Y τ "


subsection‹As a Motivation for the (infinite) Type Construction: Type-Extensions as Bags 
             \label{sec:type-extensions}›

text‹Our notion of typed bag goes beyond the usual notion of a finite executable bag and
is powerful enough to capture \emph{the extension of a type} in UML and OCL. This means
we can have in Featherweight OCL Bags containing all possible elements of a type, not only
those (finite) ones representable in a state. This holds for base types as well as class types,
although the notion for class-types --- involving object id's not occurring in a state ---
requires some care.

In a world with @{term invalid} and @{term null}, there are two notions extensions possible:
\begin{enumerate}
\item the bag of all \emph{defined} values of a type @{term T}
      (for which we will introduce the constant  @{term T})
\item the bag of all \emph{valid} values of a type @{term T}, so including @{term null}
      (for which we will introduce the constant  @{term Tnull}).
\end{enumerate}
›

text‹We define the bag extensions for the base type @{term Integer} as follows:›
definition Integer :: "('𝔄,Integerbase) Bag"
where     "Integer  (λ τ. (Abs_Bagbase o Some o Some)  (λ None  0 | Some None  0 | _  1))"

definition Integernull :: "('𝔄,Integerbase) Bag"
where     "Integernull  (λ τ. (Abs_Bagbase o Some o Some)  (λ None  0 | _  1))"

lemma Integer_defined : "δ Integer = true"
apply(rule ext, auto simp: Integer_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bagbase_inject bot_option_def bot_Bagbase_def null_Bagbase_def null_option_def)

lemma Integernull_defined : "δ Integernull = true"
apply(rule ext, auto simp: Integernull_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bagbase_inject bot_option_def bot_Bagbase_def null_Bagbase_def null_option_def)

text‹This allows the theorems:

      τ ⊨ δ x  ⟹ τ ⊨ (Integer->includesBag(x))›
      τ ⊨ δ x  ⟹ τ ⊨ Integer  ≜ (Integer->includingBag(x))›

and

      τ ⊨ υ x  ⟹ τ ⊨ (Integernull->includesBag(x))›
      τ ⊨ υ x  ⟹ τ ⊨ Integernull  ≜ (Integernull->includingBag(x))›

which characterize the infiniteness of these bags by a recursive property on these bags.
›

text‹In the same spirit, we proceed similarly for the remaining base types:›

definition Voidnull :: "('𝔄,Voidbase) Bag"
where     "Voidnull  (λ τ. (Abs_Bagbase o Some o Some) (λ x. if x = Abs_Voidbase (Some None) then 1 else 0))"

definition Voidempty :: "('𝔄,Voidbase) Bag"
where     "Voidempty  (λ τ. (Abs_Bagbase o Some o Some) (λ_. 0))"

lemma Voidnull_defined : "δ Voidnull = true"
apply(rule ext, auto simp: Voidnull_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def
                           bot_Bagbase_def null_Bagbase_def)
by((subst (asm) Abs_Bagbase_inject, auto simp add: bot_option_def null_option_def bot_Void_def),
   (subst (asm) Abs_Voidbase_inject, auto simp add: bot_option_def null_option_def))+

lemma Voidempty_defined : "δ Voidempty = true"
apply(rule ext, auto simp: Voidempty_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def
                           bot_Bagbase_def null_Bagbase_def)
by((subst (asm) Abs_Bagbase_inject, auto simp add: bot_option_def null_option_def bot_Void_def))+

lemma assumes "τ  δ (V :: ('𝔄,Voidbase) Bag)"
      shows   "τ  V  Voidnull  τ  V  Voidempty"
proof -
  have A:"x y. x  {}  y. y x"
  by (metis all_not_in_conv)
show "?thesis"
  apply(case_tac "V τ")
  proof - fix y show "V τ = Abs_Bagbase y 
                      y  {X. X =   X = null  X  = 0} 
                      τ  V  Voidnull  τ  V  Voidempty"
  apply(insert assms, case_tac y, simp add: bot_option_def, simp add: bot_Bagbase_def foundation16)
  apply(simp add: bot_option_def null_option_def)
  apply(erule disjE, metis OclValid_def defined_def foundation2 null_Bagbase_def null_fun_def true_def)
  proof - fix a show "V τ = Abs_Bagbase a  a  = 0  τ  V  Voidnull  τ  V  Voidempty"
  apply(case_tac a, simp, insert assms, metis OclValid_def foundation16 null_Bagbase_def true_def)
  apply(simp)
  proof - fix aa show " V τ = Abs_Bagbase aa  aa  = 0  τ  V  Voidnull  τ  V  Voidempty"
  apply(case_tac "aa (Abs_Voidbase None) = 0",
        rule disjI2,
        insert assms,
        simp add: Voidempty_def OclValid_def ApproxEq_def Rep_Set_base_def true_def Abs_Bagbase_inverse image_def)
  apply(intro allI)
  proof - fix x fix b show " V τ = Abs_Bagbase aa  aa  = 0  aa (Abs_Voidbase None) = 0  (δ V) τ = True  ¬ b < aa x"
    apply (case_tac x, auto)
     apply (simp add: bot_Void_def bot_option_def)
    apply (simp add: bot_option_def null_option_def)
  done
  apply_end(simp+, rule disjI1)
  show "V τ = Abs_Bagbase aa  aa  = 0  0 < aa (Abs_Voidbase None)  τ  δ V  τ  V  Voidnull"
  apply(simp add: Voidnull_def OclValid_def ApproxEq_def Rep_Set_base_def true_def Abs_Bagbase_inverse image_def,
        subst Abs_Bagbase_inverse, simp)
  using bot_Void_def apply auto[1]
  apply(simp)
  apply(rule equalityI, rule subsetI, simp)
   proof - fix x show "V τ = Abs_Bagbase aa 
            aa  = 0  0 < aa (Abs_Voidbase None)  (δ V) τ = True  b. b < aa x  x = Abs_Voidbase None"
   apply( case_tac x, auto)
    apply (simp add: bot_Void_def bot_option_def)
   by (simp add: bot_option_def null_option_def)
  qed ((simp add: bot_Void_def bot_option_def)+, blast)
qed qed qed qed qed

definition Boolean :: "('𝔄,Booleanbase) Bag"
where     "Boolean  (λ τ. (Abs_Bagbase o Some o Some)  (λ None  0 | Some None  0 | _  1))"

definition Booleannull :: "('𝔄,Booleanbase) Bag"
where     "Booleannull  (λ τ. (Abs_Bagbase o Some o Some)  (λ None  0 | _  1))"

lemma Boolean_defined : "δ Boolean = true"
apply(rule ext, auto simp: Boolean_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bagbase_inject bot_option_def bot_Bagbase_def null_Bagbase_def null_option_def)

lemma Booleannull_defined : "δ Booleannull = true"
apply(rule ext, auto simp: Booleannull_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bagbase_inject bot_option_def bot_Bagbase_def null_Bagbase_def null_option_def)

definition String :: "('𝔄,Stringbase) Bag"
where     "String  (λ τ. (Abs_Bagbase o Some o Some)  (λ None  0 | Some None  0 | _  1))"

definition Stringnull :: "('𝔄,Stringbase) Bag"
where     "Stringnull  (λ τ. (Abs_Bagbase o Some o Some)  (λ None  0 | _  1))"

lemma String_defined : "δ String = true"
apply(rule ext, auto simp: String_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bagbase_inject bot_option_def bot_Bagbase_def null_Bagbase_def null_option_def)

lemma Stringnull_defined : "δ Stringnull = true"
apply(rule ext, auto simp: Stringnull_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bagbase_inject bot_option_def bot_Bagbase_def null_Bagbase_def null_option_def)

definition Real :: "('𝔄,Realbase) Bag"
where     "Real  (λ τ. (Abs_Bagbase o Some o Some)  (λ None  0 | Some None  0 | _  1))"

definition Realnull :: "('𝔄,Realbase) Bag"
where     "Realnull  (λ τ. (Abs_Bagbase o Some o Some)  (λ None  0 | _  1))"

lemma Real_defined : "δ Real = true"
apply(rule ext, auto simp: Real_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bagbase_inject bot_option_def bot_Bagbase_def null_Bagbase_def null_option_def)

lemma Realnull_defined : "δ Realnull = true"
apply(rule ext, auto simp: Realnull_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bagbase_inject bot_option_def bot_Bagbase_def null_Bagbase_def null_option_def)

subsection‹Basic Properties of the Bag Type›

text‹Every element in a defined bag is valid.›

lemma Bag_inv_lemma: "τ  (δ X)  Rep_Bagbase (X τ) bot = 0"
apply(insert Rep_Bagbase [of "X τ"], simp)
apply(auto simp: OclValid_def defined_def false_def true_def cp_def
                 bot_fun_def bot_Bagbase_def null_Bagbase_def null_fun_def
           split:if_split_asm)
 apply(erule contrapos_pp [of "Rep_Bagbase (X τ) = bot"])
 apply(subst Abs_Bagbase_inject[symmetric], rule Rep_Bagbase, simp)
 apply(simp add: Rep_Bagbase_inverse bot_Bagbase_def bot_option_def)
apply(erule contrapos_pp [of "Rep_Bagbase (X τ) = null"])
apply(subst Abs_Bagbase_inject[symmetric], rule Rep_Bagbase, simp)
apply(simp add: Rep_Bagbase_inverse  null_option_def)
by (simp add: bot_option_def)

lemma Bag_inv_lemma' :
 assumes x_def : "τ  δ X"
     and e_mem : "Rep_Bagbase (X τ) e  1"
   shows "τ  υ (λ_. e)"
apply(case_tac "e = bot", insert assms, drule Bag_inv_lemma, simp)
by (simp add: foundation18')

lemma abs_rep_simp' :
 assumes S_all_def : "τ  δ S"
   shows "Abs_Bagbase Rep_Bagbase (S τ) = S τ"
proof -
 have discr_eq_false_true : "τ. (false τ = true τ) = False" by(simp add: false_def true_def)
 show ?thesis
  apply(insert S_all_def, simp add: OclValid_def defined_def)
  apply(rule mp[OF Abs_Bagbase_induct[where P = "λS. (if S =  τ  S = null τ
                                                    then false τ else true τ) = true τ 
                                                   Abs_Bagbase Rep_Bagbase S = S"]],
        rename_tac S')
   apply(simp add: Abs_Bagbase_inverse discr_eq_false_true)
   apply(case_tac S') apply(simp add: bot_fun_def bot_Bagbase_def)+
   apply(rename_tac S'', case_tac S'') apply(simp add: null_fun_def null_Bagbase_def)+
 done
qed

lemma invalid_bag_OclNot_defined [simp,code_unfold]:"δ(invalid::('𝔄,::null) Bag) = false" by simp
lemma null_bag_OclNot_defined [simp,code_unfold]:"δ(null::('𝔄,::null) Bag) = false"
by(simp add: defined_def null_fun_def)
lemma invalid_bag_valid [simp,code_unfold]:"υ(invalid::('𝔄,::null) Bag) = false"
by simp
lemma null_bag_valid [simp,code_unfold]:"υ(null::('𝔄,::null) Bag) = true"
apply(simp add: valid_def null_fun_def bot_fun_def bot_Bagbase_def null_Bagbase_def)
apply(subst Abs_Bagbase_inject,simp_all add: null_option_def bot_option_def)
done

text‹... which means that we can have a type ('𝔄,('𝔄,('𝔄) Integer) Bag) Bag›
corresponding exactly to Bag(Bag(Integer)) in OCL notation. Note that the parameter
'𝔄› still refers to the object universe; making the OCL semantics entirely parametric
in the object universe makes it possible to study (and prove) its properties
independently from a concrete class diagram.›

subsection‹Definition: Strict Equality \label{sec:bag-strict-equality}›

text‹After the part of foundational operations on bags, we detail here equality on bags.
Strong equality is inherited from the OCL core, but we have to consider
the case of the strict equality. We decide to overload strict equality in the
same way we do for other value's in OCL:›

overloading StrictRefEq  "StrictRefEq :: [('𝔄,::null)Bag,('𝔄,::null)Bag]  ('𝔄)Boolean"
begin
  definition StrictRefEqBag :
    "(x::('𝔄,::null)Bag)  y  λ τ. if (υ x) τ = true τ  (υ y) τ = true τ
                                       then (x  y)τ
                                       else invalid τ"
end

text‹One might object here that for the case of objects, this is an empty definition.
The answer is no, we will restrain later on states and objects such that any object
has its oid stored inside the object (so the ref, under which an object can be referenced
in the store will represented in the object itself). For such well-formed stores that satisfy
this invariant (the WFF-invariant), the referential equality and the
strong equality---and therefore the strict equality on bags in the sense above---coincides.›

text‹Property proof in terms of @{term "profile_binStrongEq_v_v"}
interpretation  StrictRefEqBag : profile_binStrongEq_v_v "λ x y. (x::('𝔄,::null)Bag)  y" 
         by unfold_locales (auto simp:  StrictRefEqBag)



subsection‹Constants: mtBag›
definition mtBag::"('𝔄,::null) Bag"  ("Bag{}")
where     "Bag{}  (λ τ.  Abs_Bagbase λ_. 0::nat )"


lemma mtBag_defined[simp,code_unfold]:"δ(Bag{}) = true"
apply(rule ext, auto simp: mtBag_def defined_def null_Bagbase_def
                           bot_Bagbase_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Bagbase_inject bot_option_def null_option_def)

lemma mtBag_valid[simp,code_unfold]:"υ(Bag{}) = true"
apply(rule ext,auto simp: mtBag_def valid_def
                          bot_Bagbase_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Bagbase_inject bot_option_def null_option_def)

lemma mtBag_rep_bag: "Rep_Bagbase (Bag{} τ) = (λ _. 0)"
 apply(simp add: mtBag_def, subst Abs_Bagbase_inverse)
by(simp add: bot_option_def)+

text_raw‹\isatagafp›

lemma [simp,code_unfold]: "const Bag{}"
by(simp add: const_def mtBag_def)


text‹Note that the collection types in OCL allow for null to be included;
  however, there is the null-collection into which inclusion yields invalid.›

text_raw‹\endisatagafp›

subsection‹Definition: Including›

definition OclIncluding   :: "[('𝔄,::null) Bag,('𝔄,) val]  ('𝔄,) Bag"
where     "OclIncluding x y = (λ τ. if (δ x) τ = true τ  (υ y) τ = true τ
                                    then Abs_Bagbase  Rep_Bagbase(x τ) 
                                                      ((y τ):=Rep_Bagbase(x τ)(y τ)+1) 
                                                    
                                    else invalid τ )"
notation   OclIncluding   ("_->includingBag'(_')")

interpretation OclIncluding : profile_bind_v OclIncluding "λx y. Abs_BagbaseRep_Bagbase x 
                                                      (y := Rep_Bagbase x y + 1)"
proof -  
   let ?X = "λx y. Rep_Bagbase(x) ((y):=Rep_Bagbase(x)( y )+1)"
   show "profile_bind_v OclIncluding (λx y. Abs_Bagbase  ?X x y )"
         apply unfold_locales  
          apply(auto simp:OclIncluding_def bot_option_def null_option_def 
                                           bot_Bagbase_def null_Bagbase_def)
          by(subst (asm) Abs_Bagbase_inject, simp_all,
             metis (mono_tags, lifting) Rep_Bagbase Rep_Bagbase_inverse bot_option_def mem_Collect_eq null_option_def,
             simp add: bot_option_def null_option_def)+
qed

syntax
  "_OclFinbag" :: "args => ('𝔄,'a::null) Bag"    ("Bag{(_)}")
translations
  "Bag{x, xs}" == "CONST OclIncluding (Bag{xs}) x"
  "Bag{x}"     == "CONST OclIncluding (Bag{}) x "


subsection‹Definition: Excluding›

definition OclExcluding   :: "[('𝔄,::null) Bag,('𝔄,) val]  ('𝔄,) Bag"
where     "OclExcluding x y = (λ τ.  if (δ x) τ = true τ  (υ y) τ = true τ
                                     then Abs_Bagbase  Rep_Bagbase (x τ) ((y τ):=0::nat) 
                                     else invalid τ )"
notation   OclExcluding   ("_->excludingBag'(_')")

interpretation OclExcluding: profile_bind_v OclExcluding  
                            "λx y. Abs_Bagbase Rep_Bagbase(x)(y:=0::nat)"
proof -
    show "profile_bind_v OclExcluding (λx y. Abs_Bagbase Rep_Bagbase x(y := 0))"
         apply unfold_locales  
         apply(auto simp:OclExcluding_def bot_option_def null_option_def  
                         null_Bagbase_def bot_Bagbase_def)
         by(subst (asm) Abs_Bagbase_inject,
               simp_all add: bot_option_def null_option_def,
               metis (mono_tags, lifting) Rep_Bagbase Rep_Bagbase_inverse bot_option_def
                                          mem_Collect_eq null_option_def)+
qed

subsection‹Definition: Includes›

definition OclIncludes   :: "[('𝔄,::null) Bag,('𝔄,) val]  '𝔄 Boolean"
where     "OclIncludes x y = (λ τ.   if (δ x) τ = true τ  (υ y) τ = true τ
                                     then  Rep_Bagbase (x τ) (y τ) > 0 
                                     else   )"
notation   OclIncludes    ("_->includesBag'(_')" (*[66,65]65*))

interpretation OclIncludes : profile_bind_v OclIncludes "λx y.  Rep_Bagbase x y > 0 "
by(unfold_locales, auto simp:OclIncludes_def bot_option_def null_option_def invalid_def)

subsection‹Definition: Excludes›

definition OclExcludes   :: "[('𝔄,::null) Bag,('𝔄,) val]  '𝔄 Boolean"
where     "OclExcludes x y = (not(OclIncludes x y))"
notation   OclExcludes    ("_->excludesBag'(_')" (*[66,65]65*))

text‹The case of the size definition is somewhat special, we admit
explicitly in Featherweight OCL the possibility of infinite bags. For
the size definition, this requires an extra condition that assures
that the cardinality of the bag is actually a defined integer.›

interpretation OclExcludes : profile_bind_v OclExcludes "λx y.  Rep_Bagbase x y  0 "
by(unfold_locales, auto simp:OclExcludes_def OclIncludes_def OclNot_def bot_option_def null_option_def invalid_def)

subsection‹Definition: Size›

definition OclSize     :: "('𝔄,::null)Bag  '𝔄 Integer"
where     "OclSize x = (λ τ. if (δ x) τ = true τ  finite (Rep_Bag_base x τ)
                             then  int (card (Rep_Bag_base x τ)) 
                             else  )"
notation  (* standard ascii syntax *)
           OclSize        ("_->sizeBag'(')" (*[66]*))

text‹The following definition follows the requirement of the
standard to treat null as neutral element of bags. It is
a well-documented exception from the general strictness
rule and the rule that the distinguished argument self should
be non-null.›

(*TODO Locale - Equivalent*)  


subsection‹Definition: IsEmpty›

definition OclIsEmpty   :: "('𝔄,::null) Bag  '𝔄 Boolean"
where     "OclIsEmpty x =  ((υ x and not (δ x)) or ((OclSize x)  𝟬))"
notation   OclIsEmpty     ("_->isEmptyBag'(')" (*[66]*))

(*TODO Locale - Equivalent*)  

subsection‹Definition: NotEmpty›

definition OclNotEmpty   :: "('𝔄,::null) Bag  '𝔄 Boolean"
where     "OclNotEmpty x =  not(OclIsEmpty x)"
notation   OclNotEmpty    ("_->notEmptyBag'(')" (*[66]*))

(*TODO Locale - Equivalent*)  

subsection‹Definition: Any›

(* Slight breach of naming convention in order to avoid naming conflict on constant.*)
definition OclANY   :: "[('𝔄,::null) Bag]  ('𝔄,) val"
where     "OclANY x = (λ τ. if (υ x) τ = true τ
                            then if (δ x and OclNotEmpty x) τ = true τ
                                 then SOME y. y  (Rep_Set_base x τ)
                                 else null τ
                            else  )"
notation   OclANY   ("_->anyBag'(')")

(*TODO Locale - Equivalent*)  

(* actually, this definition covers only: X->anyBag(true) of the standard, which foresees
a (totally correct) high-level definition
source->anyBag(iterator | body) =
source->select(iterator | body)->asSequence()->first(). Since we don't have sequences,
we have to go for a direct---restricted---definition. *)

subsection‹Definition: Forall›

text‹The definition of OclForall mimics the one of @{term "OclAnd"}:
OclForall is not a strict operation.›
definition OclForall     :: "[('𝔄,::null)Bag,('𝔄,)val('𝔄)Boolean]  '𝔄 Boolean"
where     "OclForall S P = (λ τ. if (δ S) τ = true τ
                                 then if (xRep_Set_base S τ. P (λ_. x) τ = false τ)
                                      then false τ
                                      else if (xRep_Set_base S τ. P (λ_. x) τ = invalid τ)
                                           then invalid τ
                                           else if (xRep_Set_base S τ. P (λ_. x) τ = null τ)
                                                then null τ
                                                else true τ
                                 else )"
syntax
  "_OclForallBag" :: "[('𝔄,::null) Bag,id,('𝔄)Boolean]  '𝔄 Boolean"    ("(_)->forAllBag'(_|_')")
translations
  "X->forAllBag(x | P)" == "CONST UML_Bag.OclForall X (%x. P)"

(*TODO Locale - Equivalent*)  

subsection‹Definition: Exists›
  
text‹Like OclForall, OclExists is also not strict.›
definition OclExists     :: "[('𝔄,::null) Bag,('𝔄,)val('𝔄)Boolean]  '𝔄 Boolean"
where     "OclExists S P = not(UML_Bag.OclForall S (λ X. not (P X)))"

syntax
  "_OclExistBag" :: "[('𝔄,::null) Bag,id,('𝔄)Boolean]  '𝔄 Boolean"    ("(_)->existsBag'(_|_')")
translations
  "X->existsBag(x | P)" == "CONST UML_Bag.OclExists X (%x. P)"

(*TODO Locale - Equivalent*)  
  
subsection‹Definition: Iterate›

definition OclIterate :: "[('𝔄,::null) Bag,('𝔄,::null)val,
                           ('𝔄,)val('𝔄,)val('𝔄,)val]  ('𝔄,)val"
where     "OclIterate S A F = (λ τ. if (δ S) τ = true τ  (υ A) τ = true τ  finite (Rep_Bag_base S τ)
                                    then Finite_Set.fold (F o (λa τ. a) o fst) A (Rep_Bag_base S τ) τ
                                    else )"
syntax
  "_OclIterateBag"  :: "[('𝔄,::null) Bag, idt, idt, , ] => ('𝔄,)val"
                        ("_ ->iterateBag'(_;_=_ | _')" (*[71,100,70]50*))
translations
  "X->iterateBag(a; x = A | P)" == "CONST OclIterate X A (%a. (% x. P))"

(*TODO Locale - Equivalent*)  

subsection‹Definition: Select›
  
  
definition OclSelect :: "[('𝔄,::null)Bag,('𝔄,)val('𝔄)Boolean]  ('𝔄,)Bag"
where "OclSelect S P = (λτ. if (δ S) τ = true τ
                              then if (xRep_Set_base S τ. P(λ _. x) τ = invalid τ)
                                   then invalid τ
                                   else Abs_Bagbase λx. 
                                          let n =  Rep_Bagbase (S τ)  x in
                                          if n = 0 | P (λ_. x) τ = false τ then
                                            0
                                          else
                                            n
                              else invalid τ)"
syntax
  "_OclSelectBag" :: "[('𝔄,::null) Bag,id,('𝔄)Boolean]  '𝔄 Boolean"    ("(_)->selectBag'(_|_')")
translations
  "X->selectBag(x | P)" == "CONST OclSelect X (% x. P)"

(*TODO Locale - Equivalent*)  

subsection‹Definition: Reject›

definition OclReject :: "[('𝔄,::null)Bag,('𝔄,)val('𝔄)Boolean]  ('𝔄,::null)Bag"
where "OclReject S P = OclSelect S (not o P)"
syntax
  "_OclRejectBag" :: "[('𝔄,::null) Bag,id,('𝔄)Boolean]  '𝔄 Boolean"    ("(_)->rejectBag'(_|_')")
translations
  "X->rejectBag(x | P)" == "CONST OclReject X (% x. P)"

(*TODO Locale - Equivalent*)  

subsection‹Definition: IncludesAll›

definition OclIncludesAll   :: "[('𝔄,::null) Bag,('𝔄,) Bag]  '𝔄 Boolean"
where     "OclIncludesAll x y = (λ τ.   if (δ x) τ = true τ  (δ y) τ = true τ
                                        then Rep_Bag_base y τ  Rep_Bag_base x τ 
                                        else   )"
notation   OclIncludesAll ("_->includesAllBag'(_')" (*[66,65]65*))

interpretation OclIncludesAll : profile_bind_d OclIncludesAll "λx y. Rep_Bag_base' y  Rep_Bag_base' x "
by(unfold_locales, auto simp:OclIncludesAll_def bot_option_def null_option_def invalid_def
                             Rep_Bag_base_def Rep_Bag_base'_def)

subsection‹Definition: ExcludesAll›

definition OclExcludesAll   :: "[('𝔄,::null) Bag,('𝔄,) Bag]  '𝔄 Boolean"
where     "OclExcludesAll x y = (λ τ.   if (δ x) τ = true τ  (δ y) τ = true τ
                                        then Rep_Bag_base y τ  Rep_Bag_base x τ = {} 
                                        else   )"
notation  OclExcludesAll ("_->excludesAllBag'(_')" (*[66,65]65*))

interpretation OclExcludesAll : profile_bind_d OclExcludesAll "λx y. Rep_Bag_base' y  Rep_Bag_base' x = {} "
by(unfold_locales, auto simp:OclExcludesAll_def bot_option_def null_option_def invalid_def
                             Rep_Bag_base_def Rep_Bag_base'_def)

subsection‹Definition: Union›

definition OclUnion   :: "[('𝔄,::null) Bag,('𝔄,) Bag]  ('𝔄,) Bag"
where     "OclUnion x y = (λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                                then Abs_Bagbase  λ X. Rep_Bagbase (x τ) X + 
                                                       Rep_Bagbase (y τ) X
                                else invalid τ )"
notation   OclUnion       ("_->unionBag'(_')"          (*[66,65]65*))

interpretation OclUnion : 
               profile_bind_d OclUnion "λx y. Abs_Bagbase  λ X. Rep_Bagbase x X + 
                                                                Rep_Bagbase y X"
proof -  
   show "profile_bind_d OclUnion (λx y. Abs_Bagbase  λ X. Rep_Bagbase x X + Rep_Bagbase y X)"
   apply unfold_locales 
   apply(auto simp:OclUnion_def bot_option_def null_option_def 
                   null_Bagbase_def bot_Bagbase_def)
   by(subst (asm) Abs_Bagbase_inject,
      simp_all add: bot_option_def null_option_def, 
      metis (mono_tags, lifting) Rep_Bagbase Rep_Bagbase_inverse bot_option_def mem_Collect_eq
                                 null_option_def)+
qed

subsection‹Definition: Intersection›

definition OclIntersection   :: "[('𝔄,::null) Bag,('𝔄,) Bag]  ('𝔄,) Bag"
where     "OclIntersection x y = (λ τ.  if (δ x) τ = true τ  (δ y) τ = true τ
                                        then Abs_Bagbase λ X. min (Rep_Bagbase (x τ) X) 
                                                       (Rep_Bagbase (y τ) X)
                                        else   )"
notation   OclIntersection("_->intersectionBag'(_')"   (*[71,70]70*))

interpretation OclIntersection : 
               profile_bind_d OclIntersection "λx y. Abs_Bagbase  λ X. min (Rep_Bagbase x X) 
                                                                (Rep_Bagbase y X)"
proof -  
   show "profile_bind_d OclIntersection (λx y. Abs_Bagbase  λ X. min (Rep_Bagbase x X) 
                                                                (Rep_Bagbase y X))"
   apply unfold_locales 
   apply(auto simp:OclIntersection_def bot_option_def null_option_def 
                   null_Bagbase_def bot_Bagbase_def invalid_def)
   by(subst (asm) Abs_Bagbase_inject,
      simp_all add: bot_option_def null_option_def, 
      metis (mono_tags, lifting) Rep_Bagbase Rep_Bagbase_inverse bot_option_def mem_Collect_eq min_0R
                                 null_option_def)+
qed

subsection‹Definition: Count›

definition OclCount   :: "[('𝔄,::null) Bag,('𝔄,) val]  ('𝔄) Integer"
where     "OclCount x y = (λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                             then  int(Rep_Bagbase (x τ) (y τ)) 
                             else invalid τ )"
notation   OclCount ("_->countBag'(_')"  (*[66,65]65*))

interpretation OclCount : profile_bind_d OclCount "λx y. int(Rep_Bagbase x y)"
by(unfold_locales, auto simp:OclCount_def bot_option_def null_option_def)

subsection‹Definition (future operators)›

consts (* abstract bag collection operations *)
    OclSum         :: " ('𝔄,::null) Bag  '𝔄 Integer"
  
notation  OclSum         ("_->sumBag'(')" (*[66]*))

subsection‹Logical Properties›

text‹OclIncluding›

lemma OclIncluding_valid_args_valid:
"(τ  υ(X->includingBag(x))) = ((τ (δ X))  (τ (υ x)))"
by (metis (hide_lams, no_types) OclIncluding.def_valid_then_def OclIncluding.defined_args_valid)

lemma OclIncluding_valid_args_valid''[simp,code_unfold]:
"υ(X->includingBag(x)) = ((δ X) and (υ x))"
by (simp add: OclIncluding.def_valid_then_def)

text‹etc. etc.›
text_raw‹\isatagafp› 

text‹OclExcluding›

lemma OclExcluding_valid_args_valid:
"(τ  υ(X->excludingBag(x))) = ((τ (δ X))  (τ (υ x)))"
by (metis OclExcluding.def_valid_then_def OclExcluding.defined_args_valid)

lemma OclExcluding_valid_args_valid''[simp,code_unfold]:
"υ(X->excludingBag(x)) = ((δ X) and (υ x))"
by (simp add: OclExcluding.def_valid_then_def)

text‹OclIncludes›

lemma OclIncludes_valid_args_valid:
"(τ  υ(X->includesBag(x))) = ((τ (δ X))  (τ (υ x)))"
by (simp add: OclIncludes.def_valid_then_def foundation10')

lemma OclIncludes_valid_args_valid''[simp,code_unfold]:
"υ(X->includesBag(x)) = ((δ X) and (υ x))"
by (simp add: OclIncludes.def_valid_then_def)

text‹OclExcludes›

lemma OclExcludes_valid_args_valid:
"(τ  υ(X->excludesBag(x))) = ((τ (δ X))  (τ (υ x)))"
by (simp add: OclExcludes.def_valid_then_def foundation10')

lemma OclExcludes_valid_args_valid''[simp,code_unfold]:
"υ(X->excludesBag(x)) = ((δ X) and (υ x))"
by (simp add: OclExcludes.def_valid_then_def)

text‹OclSize›

lemma OclSize_defined_args_valid: "τ  δ (X->sizeBag())  τ  δ X"
by(auto simp: OclSize_def OclValid_def true_def valid_def false_def StrongEq_def
              defined_def invalid_def bot_fun_def null_fun_def
        split: bool.split_asm HOL.if_split_asm option.split)

lemma OclSize_infinite:
assumes non_finite:"τ  not(δ(S->sizeBag()))"
shows   "(τ  not(δ(S)))  ¬ finite (Rep_Bag_base S τ)"
apply(insert non_finite, simp)
apply(rule impI)
apply(simp add: OclSize_def OclValid_def defined_def bot_fun_def null_fun_def bot_option_def null_option_def
           split: if_split_asm)
done

lemma "τ  δ X  ¬ finite (Rep_Bag_base X τ)  ¬ τ  δ (X->sizeBag())"
by(simp add: OclSize_def OclValid_def defined_def bot_fun_def false_def true_def)

lemma size_defined:
 assumes X_finite: "τ. finite (Rep_Bag_base X τ)"
 shows "δ (X->sizeBag()) = δ X"
 apply(rule ext, simp add: cp_defined[of "X->sizeBag()"] OclSize_def)
 apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite)
done

lemma size_defined':
 assumes X_finite: "finite (Rep_Bag_base X τ)"
 shows "(τ  δ (X->sizeBag())) = (τ  δ X)"
 apply(simp add: cp_defined[of "X->sizeBag()"] OclSize_def OclValid_def)
 apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite)
done

text‹OclIsEmpty›

lemma OclIsEmpty_defined_args_valid:"τ  δ (X->isEmptyBag())  τ  υ X"
  apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
                   bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def
             split: if_split_asm)
  apply(case_tac "(X->sizeBag()  𝟬) τ", simp add: bot_option_def, simp, rename_tac x)
  apply(case_tac x, simp add: null_option_def bot_option_def, simp)
  apply(simp add: OclSize_def StrictRefEqInteger valid_def)
by (metis (hide_lams, no_types)
           bot_fun_def OclValid_def defined_def foundation2 invalid_def)

lemma "τ  δ (null->isEmptyBag())"
by(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
              bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def null_is_valid
        split: if_split_asm)

lemma OclIsEmpty_infinite: "τ  δ X  ¬ finite (Rep_Bag_base X τ)  ¬ τ  δ (X->isEmptyBag())"
  apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
                   bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def
             split: if_split_asm)
  apply(case_tac "(X->sizeBag()  𝟬) τ", simp add: bot_option_def, simp, rename_tac x)
  apply(case_tac x, simp add: null_option_def bot_option_def, simp)
by(simp add: OclSize_def StrictRefEqInteger valid_def bot_fun_def false_def true_def invalid_def)

text‹OclNotEmpty›

lemma OclNotEmpty_defined_args_valid:"τ  δ (X->notEmptyBag())  τ  υ X"
by (metis (hide_lams, no_types) OclNotEmpty_def OclNot_defargs OclNot_not foundation6 foundation9
                                OclIsEmpty_defined_args_valid)

lemma "τ  δ (null->notEmptyBag())"
by (metis (hide_lams, no_types) OclNotEmpty_def OclAnd_false1 OclAnd_idem OclIsEmpty_def
                                OclNot3 OclNot4 OclOr_def defined2 defined4 transform1 valid2)

lemma OclNotEmpty_infinite: "τ  δ X  ¬ finite (Rep_Bag_base X τ)  ¬ τ  δ (X->notEmptyBag())"
 apply(simp add: OclNotEmpty_def)
 apply(drule OclIsEmpty_infinite, simp)
by (metis OclNot_defargs OclNot_not foundation6 foundation9)

lemma OclNotEmpty_has_elt : "τ  δ X 
                          τ  X->notEmptyBag() 
                          e. e  (Rep_Bag_base X τ)"
proof -
 have s_non_empty: "S. S  {}  x. x  S"
 by blast
show "τ  δ X 
      τ  X->notEmptyBag() 
      ?thesis"
 apply(simp add: OclNotEmpty_def OclIsEmpty_def deMorgan1 deMorgan2, drule foundation5)
 apply(subst (asm) (2) OclNot_def,
       simp add: OclValid_def StrictRefEqInteger StrongEq_def
            split: if_split_asm)
  prefer 2
  apply(simp add: invalid_def bot_option_def true_def)
 apply(simp add: OclSize_def valid_def split: if_split_asm,
       simp_all add: false_def true_def bot_option_def bot_fun_def OclInt0_def)
 apply(drule s_non_empty[of "Rep_Bag_base X τ"], erule exE, case_tac x)
by blast
qed

lemma OclNotEmpty_has_elt' : "τ  δ X 
                          τ  X->notEmptyBag() 
                          e. e  (Rep_Set_base X τ)"
 apply(drule OclNotEmpty_has_elt, simp)
by(simp add: Rep_Bag_base_def Rep_Set_base_def image_def)

text‹OclANY›

lemma OclANY_defined_args_valid: "τ  δ (X->anyBag())  τ  δ X"
by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def
              defined_def invalid_def bot_fun_def null_fun_def OclAnd_def
        split: bool.split_asm HOL.if_split_asm option.split)

lemma "τ  δ X  τ  X->isEmptyBag()  ¬ τ  δ (X->anyBag())"
 apply(simp add: OclANY_def OclValid_def)
 apply(subst cp_defined, subst cp_OclAnd, simp add: OclNotEmpty_def, subst (1 2) cp_OclNot,
       simp add: cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_defined[symmetric],
       simp add: false_def true_def)
by(drule foundation20[simplified OclValid_def true_def], simp)

lemma OclANY_valid_args_valid:
"(τ  υ(X->anyBag())) = (τ  υ X)"
proof -
 have A: "(τ  υ(X->anyBag()))  ((τ (υ X)))"
          by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def
                        defined_def invalid_def bot_fun_def null_fun_def
                  split: bool.split_asm HOL.if_split_asm option.split)
 have B: "(τ (υ X))  (τ  υ(X->anyBag()))"
           apply(auto simp: OclANY_def OclValid_def true_def false_def StrongEq_def
                            defined_def invalid_def valid_def bot_fun_def null_fun_def
                            bot_option_def null_option_def null_is_valid
                            OclAnd_def
                      split: bool.split_asm HOL.if_split_asm option.split)
           apply(frule Bag_inv_lemma[OF foundation16[THEN iffD2], OF conjI], simp)
           apply(subgoal_tac "(δ X) τ = true τ")
            prefer 2
            apply (metis (hide_lams, no_types) OclValid_def foundation16)
           apply(simp add: true_def,
                 drule OclNotEmpty_has_elt'[simplified OclValid_def true_def], simp)
           apply(erule exE,
                 rule someI2[where Q = "λx. x  " and P = "λy. y  (Rep_Set_base X τ)",
                             simplified not_def, THEN mp], simp, auto)
          by(simp add: Rep_Set_base_def image_def)
 show ?thesis by(auto dest:A intro:B)
qed

lemma OclANY_valid_args_valid''[simp,code_unfold]:
"υ(X->anyBag()) = (υ X)"
by(auto intro!: OclANY_valid_args_valid transform2_rev)

(* and higher order ones : forall, exists, iterate, select, reject... *)
text_raw‹\endisatagafp› 

subsection‹Execution Laws with Invalid or Null or Infinite Set as Argument›

text‹OclIncluding› (* properties already generated by the corresponding locale *)

text‹OclExcluding› (* properties already generated by the corresponding locale *)

text‹OclIncludes› (* properties already generated by the corresponding locale *)

text‹OclExcludes› (* properties already generated by the corresponding locale *)

text‹OclSize›

lemma OclSize_invalid[simp,code_unfold]:"(invalid->sizeBag()) = invalid"
by(simp add: bot_fun_def OclSize_def invalid_def defined_def valid_def false_def true_def)

lemma OclSize_null[simp,code_unfold]:"(null->sizeBag()) = invalid"
by(rule ext,
   simp add: bot_fun_def null_fun_def null_is_valid OclSize_def
             invalid_def defined_def valid_def false_def true_def)

text‹OclIsEmpty›

lemma OclIsEmpty_invalid[simp,code_unfold]:"(invalid->isEmptyBag()) = invalid"
by(simp add: OclIsEmpty_def)

lemma OclIsEmpty_null[simp,code_unfold]:"(null->isEmptyBag()) = true"
by(simp add: OclIsEmpty_def)

text‹OclNotEmpty›

lemma OclNotEmpty_invalid[simp,code_unfold]:"(invalid->notEmptyBag()) = invalid"
by(simp add: OclNotEmpty_def)

lemma OclNotEmpty_null[simp,code_unfold]:"(null->notEmptyBag()) = false"
by(simp add: OclNotEmpty_def)

text‹OclANY›

lemma OclANY_invalid[simp,code_unfold]:"(invalid->anyBag()) = invalid"
by(simp add: bot_fun_def OclANY_def invalid_def defined_def valid_def false_def true_def)

lemma OclANY_null[simp,code_unfold]:"(null->anyBag()) = null"
by(simp add: OclANY_def false_def true_def)

text‹OclForall›

lemma OclForall_invalid[simp,code_unfold]:"invalid->forAllBag(a| P a) = invalid"
by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def)

lemma OclForall_null[simp,code_unfold]:"null->forAllBag(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def)

text‹OclExists›

lemma OclExists_invalid[simp,code_unfold]:"invalid->existsBag(a| P a) = invalid"
by(simp add: OclExists_def)

lemma OclExists_null[simp,code_unfold]:"null->existsBag(a | P a) = invalid"
by(simp add: OclExists_def)

text‹OclIterate›

lemma OclIterate_invalid[simp,code_unfold]:"invalid->iterateBag(a; x = A | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)

lemma OclIterate_null[simp,code_unfold]:"null->iterateBag(a; x = A | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)


lemma OclIterate_invalid_args[simp,code_unfold]:"S->iterateBag(a; x = invalid | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)

text‹An open question is this ...›
lemma (*OclIterate_null_args[simp,code_unfold]:*) "S->iterateBag(a; x = null | P a x) = invalid"
oops
(* In the definition above, this does not hold in general.
       And I believe, this is how it should be ... *)

lemma OclIterate_infinite:
assumes non_finite: "τ  not(δ(S->sizeBag()))"
shows "(OclIterate S A F) τ = invalid τ"
apply(insert non_finite [THEN OclSize_infinite])
apply(subst (asm) foundation9, simp)
by(metis OclIterate_def OclValid_def invalid_def)

text‹OclSelect›

lemma OclSelect_invalid[simp,code_unfold]:"invalid->selectBag(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def)

lemma OclSelect_null[simp,code_unfold]:"null->selectBag(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def)

text‹OclReject›

lemma OclReject_invalid[simp,code_unfold]:"invalid->rejectBag(a | P a) = invalid"
by(simp add: OclReject_def)

lemma OclReject_null[simp,code_unfold]:"null->rejectBag(a | P a) = invalid"
by(simp add: OclReject_def)

text_raw‹\isatagafp›

subsubsection‹Context Passing›

lemma cp_OclIncludes1:
"(X->includesBag(x)) τ = (X->includesBag(λ _. x τ)) τ"
by(auto simp: OclIncludes_def StrongEq_def invalid_def
                 cp_defined[symmetric] cp_valid[symmetric])

lemma cp_OclSize: "X->sizeBag() τ = ((λ_. X τ)->sizeBag()) τ"
by(simp add: OclSize_def cp_defined[symmetric] Rep_Bag_base_def)

lemma cp_OclIsEmpty: "X->isEmptyBag() τ = ((λ_. X τ)->isEmptyBag()) τ"
 apply(simp only: OclIsEmpty_def)
 apply(subst (2) cp_OclOr,
       subst cp_OclAnd,
       subst cp_OclNot,
       subst StrictRefEqInteger.cp0)
by(simp add: cp_defined[symmetric] cp_valid[symmetric] StrictRefEqInteger.cp0[symmetric]
             cp_OclSize[symmetric] cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric])

lemma cp_OclNotEmpty: "X->notEmptyBag() τ = ((λ_. X τ)->notEmptyBag()) τ"
 apply(simp only: OclNotEmpty_def)
 apply(subst (2) cp_OclNot)
by(simp add: cp_OclNot[symmetric] cp_OclIsEmpty[symmetric])

lemma cp_OclANY: "X->anyBag() τ = ((λ_. X τ)->anyBag()) τ"
 apply(simp only: OclANY_def)
 apply(subst (2) cp_OclAnd)
by(simp only: cp_OclAnd[symmetric] cp_defined[symmetric] cp_valid[symmetric]
              cp_OclNotEmpty[symmetric] Rep_Set_base_def)

lemma cp_OclForall:
"(S->forAllBag(x | P x)) τ = ((λ _. S τ)->forAllBag(x | P (λ _. x τ))) τ"
by(auto simp add: OclForall_def cp_defined[symmetric] Rep_Set_base_def)

(* first-order version !*)
lemma cp_OclForall1 [simp,intro!]:
"cp S  cp (λX. ((S X)->forAllBag(x | P x)))"
apply(simp add: cp_def)
apply(erule exE, rule exI, intro allI)
apply(erule_tac x=X in allE)
by(subst cp_OclForall, simp)

lemma (*cp_OclForall2 [simp,intro!]:*)
"cp (λX St x. P (λτ. x) X St)  cp S  cp (λX. (S X)->forAllBag(x|P x X)) "
apply(simp only: cp_def)
oops

lemma (*cp_OclForall:*)
"cp S 
 ( x. cp(P x)) 
 cp(λX. ((S X)->forAllBag(x | P x X)))"
oops

lemma cp_OclExists:
"(S->existsBag(x | P x)) τ = ((λ _. S τ)->existsBag(x | P (λ _. x τ))) τ"
by(simp add: OclExists_def OclNot_def, subst cp_OclForall, simp)

(* first-order version !*)
lemma cp_OclExists1 [simp,intro!]:
"cp S  cp (λX. ((S X)->existsBag(x | P x)))"
apply(simp add: cp_def)
apply(erule exE, rule exI, intro allI)
apply(erule_tac x=X in allE)
by(subst cp_OclExists,simp)

lemma cp_OclIterate: 
     "(X->iterateBag(a; x = A | P a x)) τ =
                ((λ _. X τ)->iterateBag(a; x = A | P a x)) τ"
by(simp add: OclIterate_def cp_defined[symmetric] Rep_Bag_base_def)

lemma cp_OclSelect: "(X->selectBag(a | P a)) τ =
                ((λ _. X τ)->selectBag(a | P a)) τ"
by(simp add: OclSelect_def cp_defined[symmetric] Rep_Set_base_def)

lemma cp_OclReject: "(X->rejectBag(a | P a)) τ = ((λ _. X τ)->rejectBag(a | P a)) τ"
by(simp add: OclReject_def, subst cp_OclSelect, simp)

lemmas cp_intro''Bag[intro!,simp,code_unfold] =
       cp_OclSize      [THEN allI[THEN allI[THEN cpI1], of "OclSize"]]
       cp_OclIsEmpty   [THEN allI[THEN allI[THEN cpI1], of "OclIsEmpty"]]
       cp_OclNotEmpty  [THEN allI[THEN allI[THEN cpI1], of "OclNotEmpty"]]
       cp_OclANY       [THEN allI[THEN allI[THEN cpI1], of "OclANY"]]

subsubsection‹Const›

lemma const_OclIncluding[simp,code_unfold] :
 assumes const_x : "const x"
     and const_S : "const S"
   shows  "const (S->includingBag(x))"
   proof -
     have A:"τ τ'. ¬ (τ  υ x)  (S->includingBag(x) τ) = (S->includingBag(x) τ')"
            apply(simp add: foundation18)
            apply(erule const_subst[OF const_x const_invalid],simp_all)
            by(rule const_charn[OF const_invalid])
     have B: " τ τ'. ¬ (τ  δ S)  (S->includingBag(x) τ) = (S->includingBag(x) τ')"
            apply(simp add: foundation16', elim disjE)
            apply(erule const_subst[OF const_S const_invalid],simp_all)
            apply(rule const_charn[OF const_invalid])
            apply(erule const_subst[OF const_S const_null],simp_all)
            by(rule const_charn[OF const_invalid])
     show ?thesis
       apply(simp only: const_def,intro allI, rename_tac τ τ')
       apply(case_tac "¬ (τ  υ x)", simp add: A)
       apply(case_tac "¬ (τ  δ S)", simp_all add: B)
       apply(frule_tac τ'1= τ' in  const_OclValid2[OF const_x, THEN iffD1])
       apply(frule_tac τ'1= τ' in  const_OclValid1[OF const_S, THEN iffD1])
       apply(simp add: OclIncluding_def OclValid_def)
       apply(subst (1 2) const_charn[OF const_x])
       apply(subst (1 2) const_charn[OF const_S])
       by simp
qed
text_raw‹\endisatagafp›

subsection‹Test Statements›

(*Assert   "(τ ⊨ (Bag{λ_. ⌊⌊x⌋⌋} ≐ Bag{λ_. ⌊⌊x⌋⌋}))"
Assert   "(τ ⊨ (Bag{λ_. ⌊x⌋} ≐ Bag{λ_. ⌊x⌋}))"*)

instantiation Bagbase  :: (equal)equal
begin
  definition "HOL.equal k l   (k::('a::equal)Bagbase) =  l"
  instance   by standard (rule equal_Bagbase_def)
end

lemma equal_Bagbase_code [code]:
  "HOL.equal k (l::('a::{equal,null})Bagbase)  Rep_Bagbase k = Rep_Bagbase l"
  by (auto simp add: equal Bagbase.Rep_Bagbase_inject)

Assert   "τ  (Bag{}  Bag{})" 

(*
Assert   "τ ⊨ not(Bag{𝟭,𝟭}      ≜ Bag{𝟭})" 
Assert   "τ ⊨ (Bag{𝟭,𝟮}         ≜ Bag{𝟮,𝟭}" 
Assert   "τ ⊨ (Bag{𝟭,null}      ≜ Bag{null,𝟭}" 
Assert   "τ ⊨ (Bag{𝟭,invalid,𝟮} ≜ invalid)"
Assert   "τ ⊨ (Bag{𝟭,𝟮}->includingBag(null) ≜ Bag{𝟭,𝟮,null})"
*)

(* > *)

end

Theory UML_Set

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Set.thy --- Library definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)


theory  UML_Set
imports "../basic_types/UML_Void"
        "../basic_types/UML_Boolean"
        "../basic_types/UML_Integer"
        "../basic_types/UML_String"
        "../basic_types/UML_Real"
begin

no_notation None ("")
section‹Collection Type Set: Operations \label{formal-set}›

subsection‹As a Motivation for the (infinite) Type Construction: Type-Extensions as Sets 
             \label{sec:type-extensions}›

text‹Our notion of typed set goes beyond the usual notion of a finite executable set and
is powerful enough to capture \emph{the extension of a type} in UML and OCL. This means
we can have in Featherweight OCL Sets containing all possible elements of a type, not only
those (finite) ones representable in a state. This holds for base types as well as class types,
although the notion for class-types --- involving object id's not occurring in a state ---
requires some care.

In a world with @{term invalid} and @{term null}, there are two notions extensions possible:
\begin{enumerate}
\item the set of all \emph{defined} values of a type @{term T}
      (for which we will introduce the constant  @{term T})
\item the set of all \emph{valid} values of a type @{term T}, so including @{term null}
      (for which we will introduce the constant  @{term Tnull}).
\end{enumerate}
›

text‹We define the set extensions for the base type @{term Integer} as follows:›
definition Integer :: "('𝔄,Integerbase) Set"
where     "Integer  (λ τ. (Abs_Setbase o Some o Some)  ((Some o Some) ` (UNIV::int set)))"

definition Integernull :: "('𝔄,Integerbase) Set"
where     "Integernull  (λ τ. (Abs_Setbase o Some o Some)  (Some ` (UNIV::int option set)))"

lemma Integer_defined : "δ Integer = true"
apply(rule ext, auto simp: Integer_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Setbase_inject bot_option_def bot_Setbase_def null_Setbase_def null_option_def)

lemma Integernull_defined : "δ Integernull = true"
apply(rule ext, auto simp: Integernull_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Setbase_inject bot_option_def bot_Setbase_def null_Setbase_def null_option_def)

text‹This allows the theorems:

      τ ⊨ δ x  ⟹ τ ⊨ (Integer->includesSet(x))›
      τ ⊨ δ x  ⟹ τ ⊨ Integer  ≜ (Integer->includingSet(x))›

and

      τ ⊨ υ x  ⟹ τ ⊨ (Integernull->includesSet(x))›
      τ ⊨ υ x  ⟹ τ ⊨ Integernull  ≜ (Integernull->includingSet(x))›

which characterize the infiniteness of these sets by a recursive property on these sets.
›

text‹In the same spirit, we proceed similarly for the remaining base types:›

definition Voidnull :: "('𝔄,Voidbase) Set"
where     "Voidnull  (λ τ. (Abs_Setbase o Some o Some) {Abs_Voidbase (Some None)})"

definition Voidempty :: "('𝔄,Voidbase) Set"
where     "Voidempty  (λ τ. (Abs_Setbase o Some o Some) {})"

lemma Voidnull_defined : "δ Voidnull = true"
apply(rule ext, auto simp: Voidnull_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def
                           bot_Setbase_def null_Setbase_def)
by((subst (asm) Abs_Setbase_inject, auto simp add: bot_option_def null_option_def bot_Void_def),
   (subst (asm) Abs_Voidbase_inject, auto simp add: bot_option_def null_option_def))+

lemma Voidempty_defined : "δ Voidempty = true"
apply(rule ext, auto simp: Voidempty_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def
                           bot_Setbase_def null_Setbase_def)
by((subst (asm) Abs_Setbase_inject, auto simp add: bot_option_def null_option_def bot_Void_def))+

lemma assumes "τ  δ (V :: ('𝔄,Voidbase) Set)"
      shows   "τ  V  Voidnull  τ  V  Voidempty"
proof -
  have A:"x y. x  {}  y. y x"
  by (metis all_not_in_conv)
show "?thesis"
  apply(case_tac "V τ")
  proof - fix y show "V τ = Abs_Setbase y 
                      y  {X. X =   X = null  (xX. x  )} 
                      τ  V  Voidnull  τ  V  Voidempty"
  apply(insert assms, case_tac y, simp add: bot_option_def, simp add: bot_Setbase_def foundation16)
  apply(simp add: bot_option_def null_option_def)
  apply(erule disjE, metis OclValid_def defined_def foundation2 null_Setbase_def null_fun_def true_def)
  proof - fix a show "V τ = Abs_Setbase a  xa. x    τ  V  Voidnull  τ  V  Voidempty"
  apply(case_tac a, simp, insert assms, metis OclValid_def foundation16 null_Setbase_def true_def)
  apply(simp)
  proof - fix aa show " V τ = Abs_Setbase aa  xaa. x    τ  V  Voidnull  τ  V  Voidempty"
  apply(case_tac "aa = {}",
        rule disjI2,
        insert assms,
        simp add: Voidempty_def OclValid_def StrongEq_def true_def,
        rule disjI1)
  apply(subgoal_tac "aa = {Abs_Voidbase None}", simp add: StrongEq_def OclValid_def true_def Voidnull_def)
  apply(drule A, erule exE)
  proof - fix y show "V τ = Abs_Setbase aa 
                      xaa. x   
                      τ  δ V 
                      y  aa 
                      aa = {Abs_Voidbase None}"  
  apply(rule equalityI, rule subsetI, simp)
    proof - fix x show " V τ = Abs_Setbase aa 
             xaa. x    τ  δ V  y  aa  x  aa  x = Abs_Voidbase None"
    apply(case_tac x, simp)
    by (metis bot_Void_def bot_option_def null_option_def)
  apply_end(simp_all)
  
  apply_end(erule ballE[where x = y], simp_all)
  apply_end(case_tac y,
            simp add: bot_option_def null_option_def OclValid_def defined_def split: if_split_asm,
            simp add: false_def true_def)
  qed (erule disjE, simp add: bot_Void_def, simp)
qed qed qed qed qed

definition Boolean :: "('𝔄,Booleanbase) Set"
where     "Boolean  (λ τ. (Abs_Setbase o Some o Some)  ((Some o Some) ` (UNIV::bool set)))"

definition Booleannull :: "('𝔄,Booleanbase) Set"
where     "Booleannull  (λ τ. (Abs_Setbase o Some o Some)  (Some ` (UNIV::bool option set)))"

lemma Boolean_defined : "δ Boolean = true"
apply(rule ext, auto simp: Boolean_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Setbase_inject bot_option_def bot_Setbase_def null_Setbase_def null_option_def)

lemma Booleannull_defined : "δ Booleannull = true"
apply(rule ext, auto simp: Booleannull_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Setbase_inject bot_option_def bot_Setbase_def null_Setbase_def null_option_def)

definition String :: "('𝔄,Stringbase) Set"
where     "String  (λ τ. (Abs_Setbase o Some o Some)  ((Some o Some) ` (UNIV::string set)))"

definition Stringnull :: "('𝔄,Stringbase) Set"
where     "Stringnull  (λ τ. (Abs_Setbase o Some o Some)  (Some ` (UNIV::string option set)))"

lemma String_defined : "δ String = true"
apply(rule ext, auto simp: String_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Setbase_inject bot_option_def bot_Setbase_def null_Setbase_def null_option_def)

lemma Stringnull_defined : "δ Stringnull = true"
apply(rule ext, auto simp: Stringnull_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Setbase_inject bot_option_def bot_Setbase_def null_Setbase_def null_option_def)

definition Real :: "('𝔄,Realbase) Set"
where     "Real  (λ τ. (Abs_Setbase o Some o Some)  ((Some o Some) ` (UNIV::real set)))"

definition Realnull :: "('𝔄,Realbase) Set"
where     "Realnull  (λ τ. (Abs_Setbase o Some o Some)  (Some ` (UNIV::real option set)))"

lemma Real_defined : "δ Real = true"
apply(rule ext, auto simp: Real_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Setbase_inject bot_option_def bot_Setbase_def null_Setbase_def null_option_def)

lemma Realnull_defined : "δ Realnull = true"
apply(rule ext, auto simp: Realnull_def defined_def false_def true_def
                           bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Setbase_inject bot_option_def bot_Setbase_def null_Setbase_def null_option_def)

subsection‹Basic Properties of the Set Type›

text‹Every element in a defined set is valid.›

lemma Set_inv_lemma: "τ  (δ X)  xRep_Setbase (X τ). x  bot"
apply(insert Rep_Setbase [of "X τ"], simp)
apply(auto simp: OclValid_def defined_def false_def true_def cp_def
                 bot_fun_def bot_Setbase_def null_Setbase_def null_fun_def
           split:if_split_asm)
 apply(erule contrapos_pp [of "Rep_Setbase (X τ) = bot"])
 apply(subst Abs_Setbase_inject[symmetric], rule Rep_Setbase, simp)
 apply(simp add: Rep_Setbase_inverse bot_Setbase_def bot_option_def)
apply(erule contrapos_pp [of "Rep_Setbase (X τ) = null"])
apply(subst Abs_Setbase_inject[symmetric], rule Rep_Setbase, simp)
apply(simp add: Rep_Setbase_inverse  null_option_def)
by (simp add: bot_option_def)

lemma Set_inv_lemma' :
 assumes x_def : "τ  δ X"
     and e_mem : "e  Rep_Setbase (X τ)"
   shows "τ  υ (λ_. e)"
 apply(rule Set_inv_lemma[OF x_def, THEN ballE[where x = e]])
  apply(simp add: foundation18')
by(simp add: e_mem)

lemma abs_rep_simp' :
 assumes S_all_def : "τ  δ S"
   shows "Abs_Setbase Rep_Setbase (S τ) = S τ"
proof -
 have discr_eq_false_true : "τ. (false τ = true τ) = False" by(simp add: false_def true_def)
 show ?thesis
  apply(insert S_all_def, simp add: OclValid_def defined_def)
  apply(rule mp[OF Abs_Setbase_induct[where P = "λS. (if S =  τ  S = null τ
                                                    then false τ else true τ) = true τ 
                                                   Abs_Setbase Rep_Setbase S = S"]],
        rename_tac S')
   apply(simp add: Abs_Setbase_inverse discr_eq_false_true)
   apply(case_tac S') apply(simp add: bot_fun_def bot_Setbase_def)+
   apply(rename_tac S'', case_tac S'') apply(simp add: null_fun_def null_Setbase_def)+
 done
qed

lemma S_lift' :
 assumes S_all_def : "(τ :: '𝔄 st)  δ S"
   shows "S'. (λa (_::'𝔄 st). a) ` Rep_Setbase (S τ) = (λa (_::'𝔄 st). a) ` S'"
  apply(rule_tac x = "(λa. a) ` Rep_Setbase (S τ)" in exI)
  apply(simp only: image_comp)
  apply(simp add: comp_def)
  apply(rule image_cong, fast)
  (* *)
  apply(drule Set_inv_lemma'[OF S_all_def])
by(case_tac x, (simp add: bot_option_def foundation18')+)

lemma invalid_set_OclNot_defined [simp,code_unfold]:"δ(invalid::('𝔄,::null) Set) = false" by simp
lemma null_set_OclNot_defined [simp,code_unfold]:"δ(null::('𝔄,::null) Set) = false"
by(simp add: defined_def null_fun_def)
lemma invalid_set_valid [simp,code_unfold]:"υ(invalid::('𝔄,::null) Set) = false"
by simp
lemma null_set_valid [simp,code_unfold]:"υ(null::('𝔄,::null) Set) = true"
apply(simp add: valid_def null_fun_def bot_fun_def bot_Setbase_def null_Setbase_def)
apply(subst Abs_Setbase_inject,simp_all add: null_option_def bot_option_def)
done

text‹... which means that we can have a type ('𝔄,('𝔄,('𝔄) Integer) Set) Set›
corresponding exactly to Set(Set(Integer)) in OCL notation. Note that the parameter
'𝔄› still refers to the object universe; making the OCL semantics entirely parametric
in the object universe makes it possible to study (and prove) its properties
independently from a concrete class diagram.›

subsection‹Definition: Strict Equality \label{sec:set-strict-equality}›

text‹After the part of foundational operations on sets, we detail here equality on sets.
Strong equality is inherited from the OCL core, but we have to consider
the case of the strict equality. We decide to overload strict equality in the
same way we do for other value's in OCL:›

overloading
  StrictRefEq  "StrictRefEq :: [('𝔄,::null)Set,('𝔄,::null)Set]  ('𝔄)Boolean"
begin
  definition StrictRefEqSet :
    "(x::('𝔄,::null)Set)  y  λ τ. if (υ x) τ = true τ  (υ y) τ = true τ
                                       then (x  y)τ
                                       else invalid τ"
end

text‹One might object here that for the case of objects, this is an empty definition.
The answer is no, we will restrain later on states and objects such that any object
has its oid stored inside the object (so the ref, under which an object can be referenced
in the store will represented in the object itself). For such well-formed stores that satisfy
this invariant (the WFF-invariant), the referential equality and the
strong equality---and therefore the strict equality on sets in the sense above---coincides.›

text‹Property proof in terms of @{term "profile_binStrongEq_v_v"}
interpretation  StrictRefEqSet : profile_binStrongEq_v_v "λ x y. (x::('𝔄,::null)Set)  y" 
         by unfold_locales (auto simp:  StrictRefEqSet)



subsection‹Constants: mtSet›
definition mtSet::"('𝔄,::null) Set"  ("Set{}")
where     "Set{}  (λ τ.  Abs_Setbase {}:: set )"


lemma mtSet_defined[simp,code_unfold]:"δ(Set{}) = true"
apply(rule ext, auto simp: mtSet_def defined_def null_Setbase_def
                           bot_Setbase_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Setbase_inject bot_option_def null_Setbase_def null_option_def)

lemma mtSet_valid[simp,code_unfold]:"υ(Set{}) = true"
apply(rule ext,auto simp: mtSet_def valid_def null_Setbase_def
                          bot_Setbase_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Setbase_inject bot_option_def null_Setbase_def null_option_def)

lemma mtSet_rep_set: "Rep_Setbase (Set{} τ) = {}"
 apply(simp add: mtSet_def, subst Abs_Setbase_inverse)
by(simp add: bot_option_def)+

lemma [simp,code_unfold]: "const Set{}"
by(simp add: const_def mtSet_def)


text‹Note that the collection types in OCL allow for null to be included;
  however, there is the null-collection into which inclusion yields invalid.›

subsection‹Definition: Including›

definition OclIncluding   :: "[('𝔄,::null) Set,('𝔄,) val]  ('𝔄,) Set"
where     "OclIncluding x y = (λ τ. if (δ x) τ = true τ  (υ y) τ = true τ
                                    then Abs_Setbase  Rep_Setbase (x τ)   {y τ} 
                                    else invalid τ )"
notation   OclIncluding   ("_->includingSet'(_')")

interpretation OclIncluding : profile_bind_v OclIncluding "λx y. Abs_SetbaseRep_Setbase x  {y}"
proof -  
 have A : "None  {X. X = bot  X = null  (xX. x  bot)}" by(simp add: bot_option_def)
 have B : "None  {X. X = bot  X = null  (xX. x  bot)}" 
          by(simp add: null_option_def bot_option_def)
 have C : "x y. x    x  null   y    
           insert y Rep_Setbase x  {X. X = bot  X = null  (xX. x  bot)}"
           by(auto intro!:Set_inv_lemma[simplified OclValid_def 
                                        defined_def false_def true_def null_fun_def bot_fun_def])          
         show "profile_bind_v OclIncluding (λx y. Abs_SetbaseRep_Setbase x  {y})"
         apply unfold_locales  
          apply(auto simp:OclIncluding_def bot_option_def null_option_def null_Setbase_def bot_Setbase_def)
          apply(erule_tac Q="Abs_Setbaseinsert y Rep_Setbase x = Abs_Setbase None" in contrapos_pp)
          apply(subst Abs_Setbase_inject[OF C A])
             apply(simp_all add:  null_Setbase_def bot_Setbase_def bot_option_def)
         apply(erule_tac Q="Abs_Setbaseinsert y Rep_Setbase x = Abs_Setbase None" in contrapos_pp)
         apply(subst Abs_Setbase_inject[OF C B])
            apply(simp_all add:  null_Setbase_def bot_Setbase_def bot_option_def)
         done
qed

syntax
  "_OclFinset" :: "args => ('𝔄,'a::null) Set"    ("Set{(_)}")
translations
  "Set{x, xs}" == "CONST OclIncluding (Set{xs}) x"
  "Set{x}"     == "CONST OclIncluding (Set{}) x "


subsection‹Definition: Excluding›

definition OclExcluding   :: "[('𝔄,::null) Set,('𝔄,) val]  ('𝔄,) Set"
where     "OclExcluding x y = (λ τ.  if (δ x) τ = true τ  (υ y) τ = true τ
                                     then Abs_Setbase  Rep_Setbase (x τ) - {y τ} 
                                     else  )"
notation   OclExcluding   ("_->excludingSet'(_')")


lemma OclExcluding_inv: "(x:: Set('b::{null}))    x  null   y    
           Rep_Setbase x - {y}  {X. X = bot  X = null  (xX. x  bot)}"
  proof - fix X :: "'a state × 'a state  Set('b)" fix τ
          show "x    x  null  y    ?thesis"
            when "x = X τ"
  by(simp add: that Set_inv_lemma[simplified OclValid_def 
                                          defined_def null_fun_def bot_fun_def, of X τ])
qed simp_all

interpretation OclExcluding : profile_bind_v OclExcluding "λx y. Abs_SetbaseRep_Setbase x - {y}"
proof -  
 have A : "None  {X. X = bot  X = null  (xX. x  bot)}" by(simp add: bot_option_def)
 have B : "None  {X. X = bot  X = null  (xX. x  bot)}" 
          by(simp add: null_option_def bot_option_def)
         show "profile_bind_v OclExcluding (λx y. Abs_SetbaseRep_Setbase (x:: Set('b)) - {y})"
         apply unfold_locales  
          apply(auto simp:OclExcluding_def bot_option_def null_option_def null_Setbase_def bot_Setbase_def invalid_def)
          apply(erule_tac Q="Abs_SetbaseRep_Setbase x - {y} = Abs_Setbase None" in contrapos_pp)
          apply(subst Abs_Setbase_inject[OF OclExcluding_inv A])
             apply(simp_all add:  null_Setbase_def bot_Setbase_def bot_option_def)
         apply(erule_tac Q="Abs_SetbaseRep_Setbase x - {y} = Abs_Setbase None" in contrapos_pp)
         apply(subst Abs_Setbase_inject[OF OclExcluding_inv B])
            apply(simp_all add:  null_Setbase_def bot_Setbase_def bot_option_def)
         done
qed


subsection‹Definition: Includes›

definition OclIncludes   :: "[('𝔄,::null) Set,('𝔄,) val]  '𝔄 Boolean"
where     "OclIncludes x y = (λ τ.   if (δ x) τ = true τ  (υ y) τ = true τ
                                     then (y τ)  Rep_Setbase (x τ) 
                                     else   )"
notation   OclIncludes    ("_->includesSet'(_')" (*[66,65]65*))

interpretation OclIncludes : profile_bind_v OclIncludes "λx y. y  Rep_Setbase x"
by(unfold_locales, auto simp:OclIncludes_def bot_option_def null_option_def invalid_def)


subsection‹Definition: Excludes›

definition OclExcludes   :: "[('𝔄,::null) Set,('𝔄,) val]  '𝔄 Boolean"
where     "OclExcludes x y = (not(OclIncludes x y))"
notation   OclExcludes    ("_->excludesSet'(_')" (*[66,65]65*))

text‹The case of the size definition is somewhat special, we admit
explicitly in Featherweight OCL the possibility of infinite sets. For
the size definition, this requires an extra condition that assures
that the cardinality of the set is actually a defined integer.›

interpretation OclExcludes : profile_bind_v OclExcludes "λx y. y  Rep_Setbase x"
by(unfold_locales, auto simp:OclExcludes_def OclIncludes_def OclNot_def bot_option_def null_option_def invalid_def)

subsection‹Definition: Size›

definition OclSize     :: "('𝔄,::null)Set  '𝔄 Integer"
where     "OclSize x = (λ τ. if (δ x) τ = true τ  finite(Rep_Setbase (x τ))
                             then  int(card Rep_Setbase (x τ)) 
                             else  )"
notation  (* standard ascii syntax *)
           OclSize        ("_->sizeSet'(')" (*[66]*))

text‹The following definition follows the requirement of the
standard to treat null as neutral element of sets. It is
a well-documented exception from the general strictness
rule and the rule that the distinguished argument self should
be non-null.›

(*TODO Locale - Equivalent*)  


subsection‹Definition: IsEmpty›

definition OclIsEmpty   :: "('𝔄,::null) Set  '𝔄 Boolean"
where     "OclIsEmpty x =  ((υ x and not (δ x)) or ((OclSize x)  𝟬))"
notation   OclIsEmpty     ("_->isEmptySet'(')" (*[66]*))

(*TODO Locale - Equivalent*)  


subsection‹Definition: NotEmpty›

definition OclNotEmpty   :: "('𝔄,::null) Set  '𝔄 Boolean"
where     "OclNotEmpty x =  not(OclIsEmpty x)"
notation   OclNotEmpty    ("_->notEmptySet'(')" (*[66]*))

(*TODO Locale - Equivalent*)  

subsection‹Definition: Any›

(* Slight breach of naming convention in order to avoid naming conflict on constant.*)
definition OclANY   :: "[('𝔄,::null) Set]  ('𝔄,) val"
where     "OclANY x = (λ τ. if (υ x) τ = true τ
                            then if (δ x and OclNotEmpty x) τ = true τ
                                 then SOME y. y  Rep_Setbase (x τ)
                                 else null τ
                            else  )"
notation   OclANY   ("_->anySet'(')")

(*TODO Locale - Equivalent*)  

(* actually, this definition covers only: X->anySet(true) of the standard, which foresees
a (totally correct) high-level definition
source->anySet(iterator | body) =
source->select(iterator | body)->asSequence()->first(). Since we don't have sequences,
we have to go for a direct---restricted---definition. *)



subsection‹Definition: Forall›

text‹The definition of OclForall mimics the one of @{term "OclAnd"}:
OclForall is not a strict operation.›
definition OclForall     :: "[('𝔄,::null)Set,('𝔄,)val('𝔄)Boolean]  '𝔄 Boolean"
where     "OclForall S P = (λ τ. if (δ S) τ = true τ
                                 then if (xRep_Setbase (S τ). P(λ _. x) τ = false τ)
                                      then false τ
                                      else if (xRep_Setbase (S τ). P(λ _. x) τ = invalid τ)
                                           then invalid τ
                                           else if (xRep_Setbase (S τ). P(λ _. x) τ = null τ)
                                                then null τ
                                                else true τ
                                 else )"
syntax
  "_OclForallSet" :: "[('𝔄,::null) Set,id,('𝔄)Boolean]  '𝔄 Boolean"    ("(_)->forAllSet'(_|_')")
translations
  "X->forAllSet(x | P)" == "CONST UML_Set.OclForall X (%x. P)"

(*TODO Locale - Equivalent*)  

subsection‹Definition: Exists›
  
text‹Like OclForall, OclExists is also not strict.›
definition OclExists     :: "[('𝔄,::null) Set,('𝔄,)val('𝔄)Boolean]  '𝔄 Boolean"
where     "OclExists S P = not(UML_Set.OclForall S (λ X. not (P X)))"

syntax
  "_OclExistSet" :: "[('𝔄,::null) Set,id,('𝔄)Boolean]  '𝔄 Boolean"    ("(_)->existsSet'(_|_')")
translations
  "X->existsSet(x | P)" == "CONST UML_Set.OclExists X (%x. P)"

(*TODO Locale - Equivalent*)  
  
subsection‹Definition: Iterate›

definition OclIterate :: "[('𝔄,::null) Set,('𝔄,::null)val,
                             ('𝔄,)val('𝔄,)val('𝔄,)val]  ('𝔄,)val"
where "OclIterate S A F = (λ τ. if (δ S) τ = true τ  (υ A) τ = true τ  finiteRep_Setbase (S τ)
                                  then (Finite_Set.fold (F) (A) ((λa τ. a) ` Rep_Setbase (S τ)))τ
                                  else )"
syntax
  "_OclIterateSet"  :: "[('𝔄,::null) Set, idt, idt, , ] => ('𝔄,)val"
                        ("_ ->iterateSet'(_;_=_ | _')" (*[71,100,70]50*))
translations
  "X->iterateSet(a; x = A | P)" == "CONST OclIterate X A (%a. (% x. P))"

(*TODO Locale - Equivalent*)  
  
subsection‹Definition: Select›

definition OclSelect :: "[('𝔄,::null)Set,('𝔄,)val('𝔄)Boolean]  ('𝔄,)Set"
where "OclSelect S P = (λτ. if (δ S) τ = true τ
                              then if (xRep_Setbase (S τ). P(λ _. x) τ = invalid τ)
                                   then invalid τ
                                   else Abs_Setbase {x Rep_Setbase (S τ). P (λ_. x) τ  false τ}
                              else invalid τ)"
syntax
  "_OclSelectSet" :: "[('𝔄,::null) Set,id,('𝔄)Boolean]  '𝔄 Boolean"    ("(_)->selectSet'(_|_')")
translations
  "X->selectSet(x | P)" == "CONST OclSelect X (% x. P)"

(*TODO Locale - Equivalent*)  

subsection‹Definition: Reject›

definition OclReject :: "[('𝔄,::null)Set,('𝔄,)val('𝔄)Boolean]  ('𝔄,::null)Set"
where "OclReject S P = OclSelect S (not o P)"
syntax
  "_OclRejectSet" :: "[('𝔄,::null) Set,id,('𝔄)Boolean]  '𝔄 Boolean"    ("(_)->rejectSet'(_|_')")
translations
  "X->rejectSet(x | P)" == "CONST OclReject X (% x. P)"

(*TODO Locale - Equivalent*)  

subsection‹Definition: IncludesAll›

definition OclIncludesAll   :: "[('𝔄,::null) Set,('𝔄,) Set]  '𝔄 Boolean"
where     "OclIncludesAll x y = (λ τ.   if (δ x) τ = true τ  (δ y) τ = true τ
                                        then Rep_Setbase (y τ)  Rep_Setbase (x τ) 
                                        else   )"
notation   OclIncludesAll ("_->includesAllSet'(_')" (*[66,65]65*))

interpretation OclIncludesAll : profile_bind_d OclIncludesAll "λx y. Rep_Setbase y  Rep_Setbase x"
by(unfold_locales, auto simp:OclIncludesAll_def bot_option_def null_option_def invalid_def)

subsection‹Definition: ExcludesAll›

definition OclExcludesAll   :: "[('𝔄,::null) Set,('𝔄,) Set]  '𝔄 Boolean"
where     "OclExcludesAll x y = (λ τ.   if (δ x) τ = true τ  (δ y) τ = true τ
                                        then Rep_Setbase (y τ)  Rep_Setbase (x τ) = {} 
                                        else   )"
notation  OclExcludesAll ("_->excludesAllSet'(_')" (*[66,65]65*))

interpretation OclExcludesAll : profile_bind_d OclExcludesAll "λx y. Rep_Setbase y  Rep_Setbase x = {}"
by(unfold_locales, auto simp:OclExcludesAll_def bot_option_def null_option_def invalid_def)

subsection‹Definition: Union›

definition OclUnion   :: "[('𝔄,::null) Set,('𝔄,) Set]  ('𝔄,) Set"
where     "OclUnion x y = (λ τ.   if (δ x) τ = true τ  (δ y) τ = true τ
                                        then Abs_SetbaseRep_Setbase (y τ)  Rep_Setbase (x τ) 
                                        else   )"
notation   OclUnion       ("_->unionSet'(_')"          (*[66,65]65*))

lemma OclUnion_inv: "(x:: Set('b::{null}))    x  null   y     y  null 
           Rep_Setbase y  Rep_Setbase x  {X. X = bot  X = null  (xX. x  bot)}"
  proof - fix X Y :: "'a state × 'a state  Set('b)" fix τ
          show "x    x  null  y    y  null  ?thesis"
            when "x = X τ" "y = Y τ"
  by(auto simp: that,
     insert
       Set_inv_lemma[simplified OclValid_def 
                                          defined_def null_fun_def bot_fun_def, of Y τ]
       Set_inv_lemma[simplified OclValid_def 
                                          defined_def null_fun_def bot_fun_def, of X τ],
     auto)
qed simp_all

interpretation OclUnion : profile_bind_d OclUnion "λx y. Abs_SetbaseRep_Setbase y  Rep_Setbase x"
proof -  
 have A : "None  {X. X = bot  X = null  (xX. x  bot)}" by(simp add: bot_option_def)
 have B : "None  {X. X = bot  X = null  (xX. x  bot)}" 
          by(simp add: null_option_def bot_option_def)
         show "profile_bind_d OclUnion (λx y. Abs_SetbaseRep_Setbase y  Rep_Setbase x)"
         apply unfold_locales  
          apply(auto simp:OclUnion_def bot_option_def null_option_def null_Setbase_def bot_Setbase_def invalid_def)
          apply(erule_tac Q="Abs_SetbaseRep_Setbase y  Rep_Setbase x = Abs_Setbase None" in contrapos_pp)
          apply(subst Abs_Setbase_inject[OF OclUnion_inv A])
             apply(simp_all add:  null_Setbase_def bot_Setbase_def bot_option_def)
         apply(erule_tac Q="Abs_SetbaseRep_Setbase y  Rep_Setbase x = Abs_Setbase None" in contrapos_pp)
         apply(subst Abs_Setbase_inject[OF OclUnion_inv B])
            apply(simp_all add:  null_Setbase_def bot_Setbase_def bot_option_def)
         done
qed

subsection‹Definition: Intersection›

definition OclIntersection   :: "[('𝔄,::null) Set,('𝔄,) Set]  ('𝔄,) Set"
where     "OclIntersection x y = (λ τ.  if (δ x) τ = true τ  (δ y) τ = true τ
                                        then Abs_SetbaseRep_Setbase (y τ) 
                                                          Rep_Setbase (x τ)
                                        else   )"
notation   OclIntersection("_->intersectionSet'(_')"   (*[71,70]70*))

lemma OclIntersection_inv: "(x:: Set('b::{null}))    x  null   y     y  null 
           Rep_Setbase y  Rep_Setbase x  {X. X = bot  X = null  (xX. x  bot)}"
  proof - fix X Y :: "'a state × 'a state  Set('b)" fix τ
          show "x    x  null  y    y  null  ?thesis"
            when "x = X τ" "y = Y τ"
  by(auto simp: that,
     insert
       Set_inv_lemma[simplified OclValid_def 
                                          defined_def null_fun_def bot_fun_def, of Y τ]
       Set_inv_lemma[simplified OclValid_def 
                                          defined_def null_fun_def bot_fun_def, of X τ],
     auto)
qed simp_all

interpretation OclIntersection : profile_bind_d OclIntersection "λx y. Abs_SetbaseRep_Setbase y  Rep_Setbase x"
proof -  
 have A : "None  {X. X = bot  X = null  (xX. x  bot)}" by(simp add: bot_option_def)
 have B : "None  {X. X = bot  X = null  (xX. x  bot)}" 
          by(simp add: null_option_def bot_option_def)
         show "profile_bind_d OclIntersection (λx y. Abs_SetbaseRep_Setbase y  Rep_Setbase x)"
         apply unfold_locales  
          apply(auto simp:OclIntersection_def bot_option_def null_option_def null_Setbase_def bot_Setbase_def invalid_def)
          apply(erule_tac Q="Abs_SetbaseRep_Setbase y  Rep_Setbase x = Abs_Setbase None" in contrapos_pp)
          apply(subst Abs_Setbase_inject[OF OclIntersection_inv A])
             apply(simp_all add:  null_Setbase_def bot_Setbase_def bot_option_def)
         apply(erule_tac Q="Abs_SetbaseRep_Setbase y  Rep_Setbase x = Abs_Setbase None" in contrapos_pp)
         apply(subst Abs_Setbase_inject[OF OclIntersection_inv B])
            apply(simp_all add:  null_Setbase_def bot_Setbase_def bot_option_def)
         done
qed

subsection‹Definition (future operators)›

consts (* abstract set collection operations *)
    OclCount       :: "[('𝔄,::null) Set,('𝔄,) Set]  '𝔄 Integer"
    OclSum         :: " ('𝔄,::null) Set  '𝔄 Integer"
  
notation  OclCount       ("_->countSet'(_')" (*[66,65]65*))
notation  OclSum         ("_->sumSet'(')" (*[66]*))

subsection‹Logical Properties›

text‹OclIncluding›

lemma OclIncluding_valid_args_valid:
"(τ  υ(X->includingSet(x))) = ((τ (δ X))  (τ (υ x)))"
by (metis (hide_lams, no_types) OclIncluding.def_valid_then_def OclIncluding.defined_args_valid)

lemma OclIncluding_valid_args_valid''[simp,code_unfold]:
"υ(X->includingSet(x)) = ((δ X) and (υ x))"
by (simp add: OclIncluding.def_valid_then_def)

text‹etc. etc.›
text_raw‹\isatagafp› 

text‹OclExcluding›

lemma OclExcluding_valid_args_valid:
"(τ  υ(X->excludingSet(x))) = ((τ (δ X))  (τ (υ x)))"
by (metis OclExcluding.def_valid_then_def OclExcluding.defined_args_valid)

lemma OclExcluding_valid_args_valid''[simp,code_unfold]:
"υ(X->excludingSet(x)) = ((δ X) and (υ x))"
by (simp add: OclExcluding.def_valid_then_def)

text‹OclIncludes›

lemma OclIncludes_valid_args_valid:
"(τ  υ(X->includesSet(x))) = ((τ (δ X))  (τ (υ x)))"
by (simp add: OclIncludes.def_valid_then_def foundation10')

lemma OclIncludes_valid_args_valid''[simp,code_unfold]:
"υ(X->includesSet(x)) = ((δ X) and (υ x))"
by (simp add: OclIncludes.def_valid_then_def)

text‹OclExcludes›

lemma OclExcludes_valid_args_valid:
"(τ  υ(X->excludesSet(x))) = ((τ (δ X))  (τ (υ x)))"
by (simp add: OclExcludes.def_valid_then_def foundation10')

lemma OclExcludes_valid_args_valid''[simp,code_unfold]:
"υ(X->excludesSet(x)) = ((δ X) and (υ x))"
by (simp add: OclExcludes.def_valid_then_def)

text‹OclSize›

lemma OclSize_defined_args_valid: "τ  δ (X->sizeSet())  τ  δ X"
by(auto simp: OclSize_def OclValid_def true_def valid_def false_def StrongEq_def
              defined_def invalid_def bot_fun_def null_fun_def
        split: bool.split_asm HOL.if_split_asm option.split)

lemma OclSize_infinite:
assumes non_finite:"τ  not(δ(S->sizeSet()))"
shows   "(τ  not(δ(S)))  ¬ finite Rep_Setbase (S τ)"
apply(insert non_finite, simp)
apply(rule impI)
apply(simp add: OclSize_def OclValid_def defined_def)
apply(case_tac "finite Rep_Setbase (S τ)",
      simp_all add:null_fun_def null_option_def bot_fun_def bot_option_def)
done

lemma "τ  δ X  ¬ finite Rep_Setbase (X τ)  ¬ τ  δ (X->sizeSet())"
by(simp add: OclSize_def OclValid_def defined_def bot_fun_def false_def true_def)

lemma size_defined:
 assumes X_finite: "τ. finite Rep_Setbase (X τ)"
 shows "δ (X->sizeSet()) = δ X"
 apply(rule ext, simp add: cp_defined[of "X->sizeSet()"] OclSize_def)
 apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite)
done

lemma size_defined':
 assumes X_finite: "finite Rep_Setbase (X τ)"
 shows "(τ  δ (X->sizeSet())) = (τ  δ X)"
 apply(simp add: cp_defined[of "X->sizeSet()"] OclSize_def OclValid_def)
 apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite)
done

text‹OclIsEmpty›

lemma OclIsEmpty_defined_args_valid:"τ  δ (X->isEmptySet())  τ  υ X"
  apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
                   bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def
             split: if_split_asm)
  apply(case_tac "(X->sizeSet()  𝟬) τ", simp add: bot_option_def, simp, rename_tac x)
  apply(case_tac x, simp add: null_option_def bot_option_def, simp)
  apply(simp add: OclSize_def StrictRefEqInteger valid_def)
by (metis (hide_lams, no_types)
           bot_fun_def OclValid_def defined_def foundation2 invalid_def)

lemma "τ  δ (null->isEmptySet())"
by(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
              bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def null_is_valid
        split: if_split_asm)

lemma OclIsEmpty_infinite: "τ  δ X  ¬ finite Rep_Setbase (X τ)  ¬ τ  δ (X->isEmptySet())"
  apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
                   bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def
             split: if_split_asm)
  apply(case_tac "(X->sizeSet()  𝟬) τ", simp add: bot_option_def, simp, rename_tac x)
  apply(case_tac x, simp add: null_option_def bot_option_def, simp)
by(simp add: OclSize_def StrictRefEqInteger valid_def bot_fun_def false_def true_def invalid_def)

text‹OclNotEmpty›

lemma OclNotEmpty_defined_args_valid:"τ  δ (X->notEmptySet())  τ  υ X"
by (metis (hide_lams, no_types) OclNotEmpty_def OclNot_defargs OclNot_not foundation6 foundation9
                                OclIsEmpty_defined_args_valid)

lemma "τ  δ (null->notEmptySet())"
by (metis (hide_lams, no_types) OclNotEmpty_def OclAnd_false1 OclAnd_idem OclIsEmpty_def
                                OclNot3 OclNot4 OclOr_def defined2 defined4 transform1 valid2)

lemma OclNotEmpty_infinite: "τ  δ X  ¬ finite Rep_Setbase (X τ)  ¬ τ  δ (X->notEmptySet())"
 apply(simp add: OclNotEmpty_def)
 apply(drule OclIsEmpty_infinite, simp)
by (metis OclNot_defargs OclNot_not foundation6 foundation9)

lemma OclNotEmpty_has_elt : "τ  δ X 
                          τ  X->notEmptySet() 
                          e. e  Rep_Setbase (X τ)"
 apply(simp add: OclNotEmpty_def OclIsEmpty_def deMorgan1 deMorgan2, drule foundation5)
 apply(subst (asm) (2) OclNot_def,
       simp add: OclValid_def StrictRefEqInteger StrongEq_def
            split: if_split_asm)
  prefer 2
  apply(simp add: invalid_def bot_option_def true_def)
 apply(simp add: OclSize_def valid_def split: if_split_asm,
       simp_all add: false_def true_def bot_option_def bot_fun_def OclInt0_def)
by (metis equals0I)

text‹OclANY›

lemma OclANY_defined_args_valid: "τ  δ (X->anySet())  τ  δ X"
by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def
              defined_def invalid_def bot_fun_def null_fun_def OclAnd_def
        split: bool.split_asm HOL.if_split_asm option.split)

lemma "τ  δ X  τ  X->isEmptySet()  ¬ τ  δ (X->anySet())"
 apply(simp add: OclANY_def OclValid_def)
 apply(subst cp_defined, subst cp_OclAnd, simp add: OclNotEmpty_def, subst (1 2) cp_OclNot,
       simp add: cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_defined[symmetric],
       simp add: false_def true_def)
by(drule foundation20[simplified OclValid_def true_def], simp)

lemma OclANY_valid_args_valid:
"(τ  υ(X->anySet())) = (τ  υ X)"
proof -
 have A: "(τ  υ(X->anySet()))  ((τ (υ X)))"
          by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def
                        defined_def invalid_def bot_fun_def null_fun_def
                  split: bool.split_asm HOL.if_split_asm option.split)
 have B: "(τ (υ X))  (τ  υ(X->anySet()))"
           apply(auto simp: OclANY_def OclValid_def true_def false_def StrongEq_def
                            defined_def invalid_def valid_def bot_fun_def null_fun_def
                            bot_option_def null_option_def null_is_valid
                            OclAnd_def
                      split: bool.split_asm HOL.if_split_asm option.split)
           apply(frule Set_inv_lemma[OF foundation16[THEN iffD2], OF conjI], simp)
           apply(subgoal_tac "(δ X) τ = true τ")
            prefer 2
            apply (metis (hide_lams, no_types) OclValid_def foundation16)
           apply(simp add: true_def,
                 drule OclNotEmpty_has_elt[simplified OclValid_def true_def], simp)
          by(erule exE,
             insert someI2[where Q = "λx. x  " and P = "λy. y  Rep_Setbase (X τ)"],
             simp)
 show ?thesis by(auto dest:A intro:B)
qed

lemma OclANY_valid_args_valid''[simp,code_unfold]:
"υ(X->anySet()) = (υ X)"
by(auto intro!: OclANY_valid_args_valid transform2_rev)

(* and higher order ones : forall, exists, iterate, select, reject... *)
text_raw‹\endisatagafp› 

subsection‹Execution Laws with Invalid or Null or Infinite Set as Argument›

text‹OclIncluding› (* properties already generated by the corresponding locale *)

text‹OclExcluding› (* properties already generated by the corresponding locale *)

text‹OclIncludes› (* properties already generated by the corresponding locale *)

text‹OclExcludes› (* properties already generated by the corresponding locale *)

text‹OclSize›

lemma OclSize_invalid[simp,code_unfold]:"(invalid->sizeSet()) = invalid"
by(simp add: bot_fun_def OclSize_def invalid_def defined_def valid_def false_def true_def)

lemma OclSize_null[simp,code_unfold]:"(null->sizeSet()) = invalid"
by(rule ext,
   simp add: bot_fun_def null_fun_def null_is_valid OclSize_def
             invalid_def defined_def valid_def false_def true_def)

text‹OclIsEmpty›

lemma OclIsEmpty_invalid[simp,code_unfold]:"(invalid->isEmptySet()) = invalid"
by(simp add: OclIsEmpty_def)

lemma OclIsEmpty_null[simp,code_unfold]:"(null->isEmptySet()) = true"
by(simp add: OclIsEmpty_def)

text‹OclNotEmpty›

lemma OclNotEmpty_invalid[simp,code_unfold]:"(invalid->notEmptySet()) = invalid"
by(simp add: OclNotEmpty_def)

lemma OclNotEmpty_null[simp,code_unfold]:"(null->notEmptySet()) = false"
by(simp add: OclNotEmpty_def)

text‹OclANY›

lemma OclANY_invalid[simp,code_unfold]:"(invalid->anySet()) = invalid"
by(simp add: bot_fun_def OclANY_def invalid_def defined_def valid_def false_def true_def)

lemma OclANY_null[simp,code_unfold]:"(null->anySet()) = null"
by(simp add: OclANY_def false_def true_def)

text‹OclForall›

lemma OclForall_invalid[simp,code_unfold]:"invalid->forAllSet(a| P a) = invalid"
by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def)

lemma OclForall_null[simp,code_unfold]:"null->forAllSet(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def)

text‹OclExists›

lemma OclExists_invalid[simp,code_unfold]:"invalid->existsSet(a| P a) = invalid"
by(simp add: OclExists_def)

lemma OclExists_null[simp,code_unfold]:"null->existsSet(a | P a) = invalid"
by(simp add: OclExists_def)

text‹OclIterate›

lemma OclIterate_invalid[simp,code_unfold]:"invalid->iterateSet(a; x = A | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)

lemma OclIterate_null[simp,code_unfold]:"null->iterateSet(a; x = A | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)


lemma OclIterate_invalid_args[simp,code_unfold]:"S->iterateSet(a; x = invalid | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)

text‹An open question is this ...›
lemma (*OclIterate_null_args[simp,code_unfold]:*) "S->iterateSet(a; x = null | P a x) = invalid"
oops
(* In the definition above, this does not hold in general.
       And I believe, this is how it should be ... *)

lemma OclIterate_infinite:
assumes non_finite: "τ  not(δ(S->sizeSet()))"
shows "(OclIterate S A F) τ = invalid τ"
apply(insert non_finite [THEN OclSize_infinite])
apply(subst (asm) foundation9, simp)
by(metis OclIterate_def OclValid_def invalid_def)

text‹OclSelect›

lemma OclSelect_invalid[simp,code_unfold]:"invalid->selectSet(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def)

lemma OclSelect_null[simp,code_unfold]:"null->selectSet(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def)

text‹OclReject›

lemma OclReject_invalid[simp,code_unfold]:"invalid->rejectSet(a | P a) = invalid"
by(simp add: OclReject_def)

lemma OclReject_null[simp,code_unfold]:"null->rejectSet(a | P a) = invalid"
by(simp add: OclReject_def)

text_raw‹\isatagafp›

subsubsection‹Context Passing›

lemma cp_OclIncludes1:
"(X->includesSet(x)) τ = (X->includesSet(λ _. x τ)) τ"
by(auto simp: OclIncludes_def StrongEq_def invalid_def
                 cp_defined[symmetric] cp_valid[symmetric])

lemma cp_OclSize: "X->sizeSet() τ = ((λ_. X τ)->sizeSet()) τ"
by(simp add: OclSize_def cp_defined[symmetric])

lemma cp_OclIsEmpty: "X->isEmptySet() τ = ((λ_. X τ)->isEmptySet()) τ"
 apply(simp only: OclIsEmpty_def)
 apply(subst (2) cp_OclOr,
       subst cp_OclAnd,
       subst cp_OclNot,
       subst StrictRefEqInteger.cp0)
by(simp add: cp_defined[symmetric] cp_valid[symmetric] StrictRefEqInteger.cp0[symmetric]
             cp_OclSize[symmetric] cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric])

lemma cp_OclNotEmpty: "X->notEmptySet() τ = ((λ_. X τ)->notEmptySet()) τ"
 apply(simp only: OclNotEmpty_def)
 apply(subst (2) cp_OclNot)
by(simp add: cp_OclNot[symmetric] cp_OclIsEmpty[symmetric])

lemma cp_OclANY: "X->anySet() τ = ((λ_. X τ)->anySet()) τ"
 apply(simp only: OclANY_def)
 apply(subst (2) cp_OclAnd)
by(simp only: cp_OclAnd[symmetric] cp_defined[symmetric] cp_valid[symmetric]
              cp_OclNotEmpty[symmetric])

lemma cp_OclForall:
"(S->forAllSet(x | P x)) τ = ((λ _. S τ)->forAllSet(x | P (λ _. x τ))) τ"
by(simp add: OclForall_def cp_defined[symmetric])

(* first-order version !*)
lemma cp_OclForall1 [simp,intro!]:
"cp S  cp (λX. ((S X)->forAllSet(x | P x)))"
apply(simp add: cp_def)
apply(erule exE, rule exI, intro allI)
apply(erule_tac x=X in allE)
by(subst cp_OclForall, simp)

lemma (*cp_OclForall2 [simp,intro!]:*)
"cp (λX St x. P (λτ. x) X St)  cp S  cp (λX. (S X)->forAllSet(x|P x X)) "
apply(simp only: cp_def)
oops

lemma (*cp_OclForall:*)
"cp S 
 ( x. cp(P x)) 
 cp(λX. ((S X)->forAllSet(x | P x X)))"
oops

lemma cp_OclExists:
"(S->existsSet(x | P x)) τ = ((λ _. S τ)->existsSet(x | P (λ _. x τ))) τ"
by(simp add: OclExists_def OclNot_def, subst cp_OclForall, simp)

(* first-order version !*)
lemma cp_OclExists1 [simp,intro!]:
"cp S  cp (λX. ((S X)->existsSet(x | P x)))"
apply(simp add: cp_def)
apply(erule exE, rule exI, intro allI)
apply(erule_tac x=X in allE)
by(subst cp_OclExists,simp)

lemma cp_OclIterate: 
     "(X->iterateSet(a; x = A | P a x)) τ =
                ((λ _. X τ)->iterateSet(a; x = A | P a x)) τ"
by(simp add: OclIterate_def cp_defined[symmetric])

lemma cp_OclSelect: "(X->selectSet(a | P a)) τ =
                ((λ _. X τ)->selectSet(a | P a)) τ"
by(simp add: OclSelect_def cp_defined[symmetric])

lemma cp_OclReject: "(X->rejectSet(a | P a)) τ = ((λ _. X τ)->rejectSet(a | P a)) τ"
by(simp add: OclReject_def, subst cp_OclSelect, simp)

lemmas cp_intro''Set[intro!,simp,code_unfold] =
       cp_OclSize      [THEN allI[THEN allI[THEN cpI1], of "OclSize"]]
       cp_OclIsEmpty   [THEN allI[THEN allI[THEN cpI1], of "OclIsEmpty"]]
       cp_OclNotEmpty  [THEN allI[THEN allI[THEN cpI1], of "OclNotEmpty"]]
       cp_OclANY       [THEN allI[THEN allI[THEN cpI1], of "OclANY"]]

subsubsection‹Const›

lemma const_OclIncluding[simp,code_unfold] :
 assumes const_x : "const x"
     and const_S : "const S"
   shows  "const (S->includingSet(x))"
   proof -
     have A:"τ τ'. ¬ (τ  υ x)  (S->includingSet(x) τ) = (S->includingSet(x) τ')"
            apply(simp add: foundation18)
            apply(erule const_subst[OF const_x const_invalid],simp_all)
            by(rule const_charn[OF const_invalid])
     have B: " τ τ'. ¬ (τ  δ S)  (S->includingSet(x) τ) = (S->includingSet(x) τ')"
            apply(simp add: foundation16', elim disjE)
            apply(erule const_subst[OF const_S const_invalid],simp_all)
            apply(rule const_charn[OF const_invalid])
            apply(erule const_subst[OF const_S const_null],simp_all)
            by(rule const_charn[OF const_invalid])
     show ?thesis
       apply(simp only: const_def,intro allI, rename_tac τ τ')
       apply(case_tac "¬ (τ  υ x)", simp add: A)
       apply(case_tac "¬ (τ  δ S)", simp_all add: B)
       apply(frule_tac τ'1= τ' in  const_OclValid2[OF const_x, THEN iffD1])
       apply(frule_tac τ'1= τ' in  const_OclValid1[OF const_S, THEN iffD1])
       apply(simp add: OclIncluding_def OclValid_def)
       apply(subst const_charn[OF const_x])
       apply(subst const_charn[OF const_S])
       by simp
qed
text_raw‹\endisatagafp›

subsection‹General Algebraic Execution Rules›
subsubsection‹Execution Rules on Including›

lemma OclIncluding_finite_rep_set :
  assumes X_def : "τ  δ X"
      and x_val : "τ  υ x"
    shows "finite Rep_Setbase (X->includingSet(x) τ) = finite Rep_Setbase (X τ)"
 proof -
  have C : "insert (x τ) Rep_Setbase (X τ)  {X. X = bot  X = null  (xX. x  bot)}"
          by(insert X_def x_val, frule Set_inv_lemma, simp add: foundation18 invalid_def)
 show "?thesis"
  by(insert X_def x_val,
     auto simp: OclIncluding_def Abs_Setbase_inverse[OF C]
          dest: foundation13[THEN iffD2, THEN foundation22[THEN iffD1]])
qed

lemma OclIncluding_rep_set:
 assumes S_def: "τ  δ S"
   shows "Rep_Setbase (S->includingSet(λ_. x) τ) = insert x Rep_Setbase (S τ)"
 apply(simp add: OclIncluding_def S_def[simplified OclValid_def])
 apply(subst Abs_Setbase_inverse, simp add: bot_option_def null_option_def)
 apply(insert Set_inv_lemma[OF S_def], metis bot_option_def not_Some_eq)
 by(simp)

lemma OclIncluding_notempty_rep_set:
 assumes X_def: "τ  δ X"
     and a_val: "τ  υ a"
  shows "Rep_Setbase (X->includingSet(a) τ)  {}"
 apply(simp add: OclIncluding_def X_def[simplified OclValid_def] a_val[simplified OclValid_def])
 apply(subst Abs_Setbase_inverse, simp add: bot_option_def null_option_def)
 apply(insert Set_inv_lemma[OF X_def], metis a_val foundation18')
 by(simp)

lemma OclIncluding_includes0:
 assumes "τ  X->includesSet(x)"
   shows "X->includingSet(x) τ = X τ"
proof -
 have includes_def: "τ  X->includesSet(x)  τ  δ X"
 by (metis bot_fun_def OclIncludes_def OclValid_def defined3 foundation16)

 have includes_val: "τ  X->includesSet(x)  τ  υ x"
 using foundation5 foundation6 by fastforce

 show ?thesis
  apply(insert includes_def[OF assms] includes_val[OF assms] assms,
        simp add: OclIncluding_def OclIncludes_def OclValid_def true_def)
  apply(drule insert_absorb, simp, subst abs_rep_simp')
 by(simp_all add: OclValid_def true_def)
qed

lemma OclIncluding_includes:
 assumes "τ  X->includesSet(x)"
   shows "τ  X->includingSet(x)  X"
by(simp add: StrongEq_def OclValid_def true_def OclIncluding_includes0[OF assms])

lemma OclIncluding_commute0 :
 assumes S_def : "τ  δ S"
     and i_val : "τ  υ i"
     and j_val : "τ  υ j"
   shows "τ  ((S :: ('𝔄, 'a::null) Set)->includingSet(i)->includingSet(j)  (S->includingSet(j)->includingSet(i)))"
proof -
  have A : "insert (i τ) Rep_Setbase (S τ)  {X. X = bot  X = null  (xX. x  bot)}"
           by(insert S_def i_val, frule Set_inv_lemma, simp add: foundation18 invalid_def)
  have B : "insert (j τ) Rep_Setbase (S τ)  {X. X = bot  X = null  (xX. x  bot)}"
           by(insert S_def j_val, frule Set_inv_lemma, simp add: foundation18 invalid_def)

  have G1 : "Abs_Setbase insert (i τ) Rep_Setbase (S τ)  Abs_Setbase None"
           by(insert A, simp add: Abs_Setbase_inject bot_option_def null_option_def)
  have G2 : "Abs_Setbase insert (i τ) Rep_Setbase (S τ)  Abs_Setbase None"
           by(insert A, simp add: Abs_Setbase_inject bot_option_def null_option_def)
  have G3 : "Abs_Setbase insert (j τ) Rep_Setbase (S τ)  Abs_Setbase None"
           by(insert B, simp add: Abs_Setbase_inject bot_option_def null_option_def)
  have G4 : "Abs_Setbase insert (j τ) Rep_Setbase (S τ)  Abs_Setbase None"
           by(insert B, simp add: Abs_Setbase_inject bot_option_def null_option_def)

  have *   : "(δ (λ_. Abs_Setbase insert (i τ) Rep_Setbase (S τ))) τ = True"
             by(auto simp: OclValid_def false_def  defined_def null_fun_def  true_def
                              bot_fun_def bot_Setbase_def  null_Setbase_def S_def i_val G1 G2)

  have **  : "(δ (λ_. Abs_Setbase insert (j τ) Rep_Setbase (S τ))) τ = True"
             by(auto simp: OclValid_def false_def  defined_def null_fun_def  true_def
                              bot_fun_def bot_Setbase_def  null_Setbase_def S_def i_val G3 G4)

  have *** : "Abs_Setbase insert(j τ)Rep_Setbase(Abs_Setbaseinsert(i τ)Rep_Setbase(S τ)) =
              Abs_Setbase insert(i τ)Rep_Setbase(Abs_Setbaseinsert(j τ)Rep_Setbase(S τ))"
              by(simp add: Abs_Setbase_inverse[OF A] Abs_Setbase_inverse[OF B] Set.insert_commute)
  show ?thesis
     apply(simp add: OclIncluding_def S_def[simplified OclValid_def]
                  i_val[simplified OclValid_def] j_val[simplified OclValid_def]
                  true_def OclValid_def StrongEq_def)
     apply(subst cp_defined,
           simp add: S_def[simplified OclValid_def]
                     i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *)
     apply(subst cp_defined,
           simp add: S_def[simplified OclValid_def]
                     i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def ** ***)
     apply(subst cp_defined,
           simp add: S_def[simplified OclValid_def]
                     i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *)
     apply(subst cp_defined,
           simp add: S_def[simplified OclValid_def]
                     i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * )
     apply(subst cp_defined,
           simp add: S_def[simplified OclValid_def]
                     i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * **)
     done
qed


lemma OclIncluding_commute[simp,code_unfold]:
"((S :: ('𝔄, 'a::null) Set)->includingSet(i)->includingSet(j) = (S->includingSet(j)->includingSet(i)))"
proof -
  have A: " τ.   τ  (i  invalid)    (S->includingSet(i)->includingSet(j)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have A': " τ.   τ  (i  invalid)    (S->includingSet(j)->includingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have B:" τ.   τ  (j  invalid)    (S->includingSet(i)->includingSet(j)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have B':" τ.   τ  (j  invalid)    (S->includingSet(j)->includingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have C: " τ.   τ  (S  invalid)    (S->includingSet(i)->includingSet(j)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have C': " τ.  τ  (S  invalid)    (S->includingSet(j)->includingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have D: " τ.   τ  (S  null)    (S->includingSet(i)->includingSet(j)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have D': " τ.  τ  (S  null)    (S->includingSet(j)->includingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  show ?thesis
    apply(rule ext, rename_tac τ)
    apply(case_tac "τ  (υ i)")
     apply(case_tac "τ  (υ j)")
      apply(case_tac "τ  (δ S)")
       apply(simp only: OclIncluding_commute0[THEN foundation22[THEN iffD1]])
      apply(simp add: foundation16', elim disjE)
     apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]])
    apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]])
   apply(simp add:foundation18 B[OF foundation22[THEN iffD2]] B'[OF foundation22[THEN iffD2]])
  apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]])
 done
qed


subsubsection‹Execution Rules on Excluding›

lemma OclExcluding_finite_rep_set :
  assumes X_def : "τ  δ X"
      and x_val : "τ  υ x"
    shows "finite Rep_Setbase (X->excludingSet(x) τ) = finite Rep_Setbase (X τ)"
 proof -
  have C : "Rep_Setbase (X τ) - {x τ}  {X. X = bot  X = null  (xX. x  bot)}"
          apply(insert X_def x_val, frule Set_inv_lemma)
          apply(simp add: foundation18 invalid_def)
          done
 show "?thesis"
  by(insert X_def x_val,
     auto simp: OclExcluding_def Abs_Setbase_inverse[OF C]
          dest: foundation13[THEN iffD2, THEN foundation22[THEN iffD1]])
qed

lemma OclExcluding_rep_set:
 assumes S_def: "τ  δ S"
   shows "Rep_Setbase (S->excludingSet(λ_. x) τ) = Rep_Setbase (S τ) - {x}"
 apply(simp add: OclExcluding_def S_def[simplified OclValid_def])
 apply(subst Abs_Setbase_inverse, simp add: bot_option_def null_option_def)
  apply(insert Set_inv_lemma[OF S_def], metis Diff_iff bot_option_def not_None_eq)
by(simp)

lemma OclExcluding_excludes0:
 assumes "τ  X->excludesSet(x)"
   shows "X->excludingSet(x) τ = X τ"
proof -
 have excludes_def: "τ  X->excludesSet(x)  τ  δ X"
 by (metis OclExcludes.def_valid_then_def OclExcludes_valid_args_valid'' foundation10' foundation6)

 have excludes_val: "τ  X->excludesSet(x)  τ  υ x"
 by (metis OclExcludes.def_valid_then_def OclExcludes_valid_args_valid'' foundation10' foundation6)

 show ?thesis
  apply(insert excludes_def[OF assms] excludes_val[OF assms] assms,
        simp add: OclExcluding_def OclExcludes_def OclIncludes_def OclNot_def OclValid_def true_def)
 by (metis (hide_lams, no_types) abs_rep_simp' assms excludes_def)
qed

lemma OclExcluding_excludes:
 assumes "τ  X->excludesSet(x)"
   shows "τ  X->excludingSet(x)  X"
by(simp add: StrongEq_def OclValid_def true_def OclExcluding_excludes0[OF assms])

lemma OclExcluding_charn0[simp]:
assumes val_x:"τ  (υ x)"
shows         "τ  ((Set{}->excludingSet(x))    Set{})"
proof -
  have A : "None  {X. X = bot  X = null  (xX. x  bot)}"
  by(simp add: null_option_def bot_option_def)
  have B : "{}  {X. X = bot  X = null  (xX. x  bot)}" by(simp add: mtSet_def)

  show ?thesis using val_x
    apply(auto simp: OclValid_def OclIncludes_def OclNot_def false_def true_def StrongEq_def
                     OclExcluding_def mtSet_def defined_def bot_fun_def null_fun_def null_Setbase_def)
     apply(auto simp: mtSet_def Setbase.Abs_Setbase_inverse
                      Setbase.Abs_Setbase_inject[OF B A])
  done
qed

lemma OclExcluding_commute0 :
 assumes S_def : "τ  δ S"
     and i_val : "τ  υ i"
     and j_val : "τ  υ j"
   shows "τ  ((S :: ('𝔄, 'a::null) Set)->excludingSet(i)->excludingSet(j)  (S->excludingSet(j)->excludingSet(i)))"
proof -
  have A : "Rep_Setbase (S τ) - {i τ}  {X. X = bot  X = null  (xX. x  bot)}"
           by(insert S_def i_val, frule Set_inv_lemma, simp add: foundation18 invalid_def)
  have B : "Rep_Setbase (S τ) - {j τ}  {X. X = bot  X = null  (xX. x  bot)}"
           by(insert S_def j_val, frule Set_inv_lemma, simp add: foundation18 invalid_def)

  have G1 : "Abs_Setbase Rep_Setbase (S τ) - {i τ}  Abs_Setbase None"
           by(insert A, simp add: Abs_Setbase_inject bot_option_def null_option_def)
  have G2 : "Abs_Setbase Rep_Setbase (S τ) - {i τ}  Abs_Setbase None"
           by(insert A, simp add: Abs_Setbase_inject bot_option_def null_option_def)
  have G3 : "Abs_Setbase Rep_Setbase (S τ) - {j τ}  Abs_Setbase None"
           by(insert B, simp add: Abs_Setbase_inject bot_option_def null_option_def)
  have G4 : "Abs_Setbase Rep_Setbase (S τ) - {j τ}  Abs_Setbase None"
           by(insert B, simp add: Abs_Setbase_inject bot_option_def null_option_def)

  have *   : "(δ (λ_. Abs_Setbase Rep_Setbase (S τ) - {i τ})) τ = True"
             by(auto simp: OclValid_def false_def  defined_def null_fun_def  true_def
                              bot_fun_def bot_Setbase_def  null_Setbase_def S_def i_val G1 G2)

  have **  : "(δ (λ_. Abs_Setbase Rep_Setbase (S τ) - {j τ})) τ = True"
             by(auto simp: OclValid_def false_def  defined_def null_fun_def  true_def
                              bot_fun_def bot_Setbase_def  null_Setbase_def S_def i_val G3 G4)

  have *** : "Abs_Setbase Rep_Setbase(Abs_SetbaseRep_Setbase(S τ)-{i τ})-{j τ} =
              Abs_Setbase Rep_Setbase(Abs_SetbaseRep_Setbase(S τ)-{j τ})-{i τ}"
              apply(simp add: Abs_Setbase_inverse[OF A] Abs_Setbase_inverse[OF B])
             by (metis Diff_insert2 insert_commute)
  show ?thesis
     apply(simp add: OclExcluding_def S_def[simplified OclValid_def]
                  i_val[simplified OclValid_def] j_val[simplified OclValid_def]
                  true_def OclValid_def StrongEq_def)
     apply(subst cp_defined,
           simp add: S_def[simplified OclValid_def]
                     i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *)
     apply(subst cp_defined,
           simp add: S_def[simplified OclValid_def]
                     i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def ** ***)
     apply(subst cp_defined,
           simp add: S_def[simplified OclValid_def]
                     i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *)
     apply(subst cp_defined,
           simp add: S_def[simplified OclValid_def]
                     i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * )
     apply(subst cp_defined,
           simp add: S_def[simplified OclValid_def]
                     i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * **)
     done
qed


lemma OclExcluding_commute[simp,code_unfold]:
"((S :: ('𝔄, 'a::null) Set)->excludingSet(i)->excludingSet(j) = (S->excludingSet(j)->excludingSet(i)))"
proof -
  have A: " τ.   τ  i  invalid    (S->excludingSet(i)->excludingSet(j)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have A': " τ.   τ  i  invalid    (S->excludingSet(j)->excludingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have B:" τ.   τ  j  invalid    (S->excludingSet(i)->excludingSet(j)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have B':" τ.   τ  j  invalid    (S->excludingSet(j)->excludingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have C: " τ.   τ  S  invalid    (S->excludingSet(i)->excludingSet(j)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have C': " τ.  τ  S  invalid    (S->excludingSet(j)->excludingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have D: " τ.   τ  S  null    (S->excludingSet(i)->excludingSet(j)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have D': " τ.  τ  S  null    (S->excludingSet(j)->excludingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  show ?thesis
    apply(rule ext, rename_tac τ)
    apply(case_tac "τ  (υ i)")
     apply(case_tac "τ  (υ j)")
      apply(case_tac "τ  (δ S)")
       apply(simp only: OclExcluding_commute0[THEN foundation22[THEN iffD1]])
      apply(simp add: foundation16', elim disjE)
     apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]])
    apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]])
   apply(simp add:foundation18 B[OF foundation22[THEN iffD2]] B'[OF foundation22[THEN iffD2]])
  apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]])
 done
qed


lemma OclExcluding_charn0_exec[simp,code_unfold]:
"(Set{}->excludingSet(x)) = (if (υ x) then Set{} else invalid endif)"
proof -
  have A: " τ. (Set{}->excludingSet(invalid)) τ = (if (υ invalid) then Set{} else invalid endif) τ"
          by simp
  have B: " τ x. τ  (υ x) 
                 (Set{}->excludingSet(x)) τ = (if (υ x) then Set{} else invalid endif) τ"
          by(simp add: OclExcluding_charn0[THEN foundation22[THEN iffD1]])
  show ?thesis
    apply(rule ext, rename_tac τ)
    apply(case_tac "τ  (υ x)")
     apply(simp add: B)
    apply(simp add: foundation18)
    apply(subst OclExcluding.cp0, simp)
    apply(simp add: cp_OclIf[symmetric] OclExcluding.cp0[symmetric] cp_valid[symmetric] A)
   done
qed

lemma OclExcluding_charn1:
assumes def_X:"τ  (δ X)"
and     val_x:"τ  (υ x)"
and     val_y:"τ  (υ y)"
and     neq  :"τ  not(x  y)"
shows         "τ  ((X->includingSet(x))->excludingSet(y))  ((X->excludingSet(y))->includingSet(x))"
proof -
 have C : "insert (x τ) Rep_Setbase (X τ)  {X. X = bot  X = null  (xX. x  bot)}"
          by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def)
 have D : "Rep_Setbase (X τ) - {y τ}  {X. X = bot  X = null  (xX. x  bot)}"
          by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def)
 have E : "x τ  y τ"
          by(insert neq,
             auto simp: OclValid_def bot_fun_def OclIncluding_def OclIncludes_def
                        false_def true_def defined_def valid_def bot_Setbase_def
                        null_fun_def null_Setbase_def StrongEq_def OclNot_def)

 have G1 : "Abs_Setbase insert (x τ) Rep_Setbase (X τ)  Abs_Setbase None"
          by(insert C, simp add: Abs_Setbase_inject bot_option_def null_option_def)
 have G2 : "Abs_Setbase insert (x τ) Rep_Setbase (X τ)  Abs_Setbase None"
          by(insert C, simp add: Abs_Setbase_inject bot_option_def null_option_def)
 have G : "(δ (λ_. Abs_Setbase insert (x τ) Rep_Setbase (X τ))) τ = true τ"
          by(auto simp: OclValid_def false_def true_def defined_def
                        bot_fun_def bot_Setbase_def null_fun_def null_Setbase_def G1 G2)

 have H1 : "Abs_Setbase Rep_Setbase (X τ) - {y τ}  Abs_Setbase None"
          by(insert D, simp add: Abs_Setbase_inject bot_option_def null_option_def)
 have H2 : "Abs_Setbase Rep_Setbase (X τ) - {y τ}  Abs_Setbase None"
          by(insert D, simp add: Abs_Setbase_inject bot_option_def null_option_def)
 have H : "(δ (λ_. Abs_Setbase Rep_Setbase (X τ) - {y τ})) τ = true τ"
          by(auto simp: OclValid_def false_def true_def defined_def
                           bot_fun_def bot_Setbase_def null_fun_def null_Setbase_def H1 H2)

 have Z : "insert (x τ) Rep_Setbase (X τ) - {y τ} = insert (x τ) (Rep_Setbase (X τ) - {y τ})"
          by(auto simp: E)
 show ?thesis
  apply(insert def_X[THEN  foundation13[THEN iffD2]] val_x[THEN  foundation13[THEN iffD2]]
               val_y[THEN  foundation13[THEN iffD2]])
  apply(simp add: foundation22 OclIncluding_def OclExcluding_def def_X[THEN foundation16[THEN iffD1]])
  apply(subst cp_defined, simp)+
  apply(simp add: G H Abs_Setbase_inverse[OF C] Abs_Setbase_inverse[OF D] Z)
  done
qed



lemma OclExcluding_charn2:
assumes def_X:"τ  (δ X)"
and     val_x:"τ  (υ x)"
shows         "τ  (((X->includingSet(x))->excludingSet(x))  (X->excludingSet(x)))"
proof -
 have C : "insert (x τ) Rep_Setbase (X τ)  {X. X = bot  X = null  (xX. x  bot)}"
          by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def)
 have G1 : "Abs_Setbase insert (x τ) Rep_Setbase (X τ)  Abs_Setbase None"
          by(insert C, simp add: Abs_Setbase_inject bot_option_def null_option_def)
 have G2 : "Abs_Setbase insert (x τ) Rep_Setbase (X τ)  Abs_Setbase None"
          by(insert C, simp add: Abs_Setbase_inject bot_option_def null_option_def)
 show ?thesis
   apply(insert def_X[THEN foundation16[THEN iffD1]]
                val_x[THEN foundation18[THEN iffD1]])
   apply(auto simp: OclValid_def bot_fun_def OclIncluding_def OclIncludes_def false_def true_def
                    invalid_def defined_def valid_def bot_Setbase_def null_fun_def null_Setbase_def
                    StrongEq_def)
   apply(subst OclExcluding.cp0)
   apply(auto simp:OclExcluding_def)
            apply(simp add: Abs_Setbase_inverse[OF C])
           apply(simp_all add: false_def true_def defined_def valid_def
                               null_fun_def bot_fun_def null_Setbase_def bot_Setbase_def
                          split: bool.split_asm HOL.if_split_asm option.split)
   apply(auto simp: G1 G2)
  done
qed




theorem OclExcluding_charn3:  "((X->includingSet(x))->excludingSet(x)) = (X->excludingSet(x))"
proof -
 have A1 : "τ. τ  (X  invalid)  (X->includingSet(x)->excludingSet(x)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
 have A1': "τ. τ  (X  invalid)  (X->excludingSet(x)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
 have A2 : "τ. τ  (X  null)  (X->includingSet(x)->excludingSet(x)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
 have A2': "τ. τ  (X  null)  (X->excludingSet(x)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
 have A3 : "τ. τ  (x  invalid)  (X->includingSet(x)->excludingSet(x)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
 have A3': "τ. τ  (x  invalid)  (X->excludingSet(x)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)

 show ?thesis
 apply(rule ext, rename_tac "τ")
 apply(case_tac "τ  (υ x)")
  apply(case_tac "τ  (δ X)")
   apply(simp only: OclExcluding_charn2[THEN foundation22[THEN iffD1]])
   apply(simp add: foundation16', elim disjE)
   apply(simp add: A1[OF foundation22[THEN iffD2]] A1'[OF foundation22[THEN iffD2]])
  apply(simp add: A2[OF foundation22[THEN iffD2]] A2'[OF foundation22[THEN iffD2]])
 apply(simp add:foundation18 A3[OF foundation22[THEN iffD2]] A3'[OF foundation22[THEN iffD2]])
 done
qed


text‹One would like a generic theorem of the form:
\begin{isar}[mathescape]
lemma OclExcluding_charn_exec:
       "(X->including$_{Set}$(x::('$\mathfrak{A}$,'a::null)val)->excluding$_{Set}$(y)) =
        (if δ X then if x ≐ y
                     then X->excluding$_{Set}$(y)
                     else X->excluding$_{Set}$(y)->including$_{Set}$(x)
                     endif
                else invalid endif)"
\end{isar}
Unfortunately, this does not hold in general, since referential equality is
an overloaded concept and has to be defined for each type individually.
Consequently, it is only valid for concrete  type instances for Boolean,
Integer, and Sets thereof...
›


text‹The computational law \emph{OclExcluding-charn-exec} becomes generic since it
uses strict equality which in itself is generic. It is possible to prove
the following generic theorem and instantiate it later (using properties
that link the polymorphic logical strong equality with the concrete instance
of strict quality).›
lemma OclExcluding_charn_exec:
 assumes strict1: "(invalid  y) = invalid"
 and     strict2: "(x  invalid) = invalid"
 and     StrictRefEq_valid_args_valid: " (x::('𝔄,'a::null)val) y τ.
                                     (τ  δ (x  y)) = ((τ  (υ x))  (τ  υ y))"
 and     cp_StrictRefEq: " (X::('𝔄,'a::null)val) Y τ. (X  Y) τ = ((λ_. X τ)  (λ_. Y τ)) τ"
 and     StrictRefEq_vs_StrongEq: " (x::('𝔄,'a::null)val) y τ.
                                      τ  υ x  τ  υ y  (τ  ((x  y)  (x  y)))"
 shows "(X->includingSet(x::('𝔄,'a::null)val)->excludingSet(y)) =
        (if δ X then if x  y
                     then X->excludingSet(y)
                     else X->excludingSet(y)->includingSet(x)
                     endif
                else invalid endif)"
proof -
 (* Lifting theorems, largely analogous OclIncludes_execute_generic,
         with the same problems wrt. strict equality. *)
 have A1: "τ. τ  (X  invalid) 
            (X->includingSet(x)->includesSet(y)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)

 have B1: "τ. τ  (X  null) 
            (X->includingSet(x)->includesSet(y)) τ = invalid  τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)

 have A2: "τ. τ  (X  invalid)  X->includingSet(x)->excludingSet(y) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)

 have B2: "τ. τ  (X  null)  X->includingSet(x)->excludingSet(y) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)

 note [simp] = cp_StrictRefEq [THEN allI[THEN allI[THEN allI[THEN cpI2]], of "StrictRefEq"]]

 have C: "τ. τ  (x  invalid) 
           (X->includingSet(x)->excludingSet(y)) τ =
           (if x  y then X->excludingSet(y) else X->excludingSet(y)->includingSet(x) endif) τ"
            apply(rule foundation22[THEN iffD1])
            apply(erule StrongEq_L_subst2_rev,simp,simp)
            by(simp add: strict1)

 have D: "τ. τ  (y  invalid) 
           (X->includingSet(x)->excludingSet(y)) τ =
           (if x  y then X->excludingSet(y) else X->excludingSet(y)->includingSet(x) endif) τ"
            apply(rule foundation22[THEN iffD1])
            apply(erule StrongEq_L_subst2_rev,simp,simp)
            by (simp add: strict2)

 have E: "τ. τ  υ x  τ  υ y 
              (if x  y then X->excludingSet(y) else X->excludingSet(y)->includingSet(x) endif) τ =
              (if x  y then X->excludingSet(y) else X->excludingSet(y)->includingSet(x) endif) τ"
           apply(subst cp_OclIf)
           apply(subst StrictRefEq_vs_StrongEq[THEN foundation22[THEN iffD1]])
           by(simp_all add: cp_OclIf[symmetric])

 have F: "τ. τ  δ X  τ  υ x  τ  (x  y) 
           (X->includingSet(x)->excludingSet(y) τ) = (X->excludingSet(y) τ)"
           apply(drule StrongEq_L_sym)
           apply(rule foundation22[THEN iffD1])
           apply(erule StrongEq_L_subst2_rev,simp)
           by(simp add: OclExcluding_charn2)

 show ?thesis
    apply(rule ext, rename_tac "τ")
    apply(case_tac "¬ (τ  (δ X))", simp add:defined_split,elim disjE A1 B1 A2 B2)
    apply(case_tac "¬ (τ  (υ x))",
          simp add:foundation18 foundation22[symmetric],
          drule StrongEq_L_sym)
     apply(simp add: foundation22 C)
    apply(case_tac "¬ (τ  (υ y))",
          simp add:foundation18 foundation22[symmetric],
          drule StrongEq_L_sym, simp add: foundation22 D, simp)
    apply(subst E,simp_all)
    apply(case_tac "τ  not (x  y)")
     apply(simp add: OclExcluding_charn1[simplified foundation22]
                     OclExcluding_charn2[simplified foundation22])
    apply(simp add: foundation9 F)
 done
qed


(* Hack to work around OF-Bug *)
schematic_goal OclExcluding_charn_execInteger[simp,code_unfold]: "?X"
by(rule OclExcluding_charn_exec[OF StrictRefEqInteger.strict1 StrictRefEqInteger.strict2
                                StrictRefEqInteger.defined_args_valid
                                StrictRefEqInteger.cp0 StrictRefEqInteger.StrictRefEq_vs_StrongEq], simp_all)

schematic_goal OclExcluding_charn_execBoolean[simp,code_unfold]: "?X"
by(rule OclExcluding_charn_exec[OF StrictRefEqBoolean.strict1 StrictRefEqBoolean.strict2
                                StrictRefEqBoolean.defined_args_valid
                             StrictRefEqBoolean.cp0 StrictRefEqBoolean.StrictRefEq_vs_StrongEq], simp_all)


schematic_goal OclExcluding_charn_execSet[simp,code_unfold]: "?X"
by(rule OclExcluding_charn_exec[OF StrictRefEqSet.strict1 StrictRefEqSet.strict2
                                StrictRefEqSet.defined_args_valid
                                StrictRefEqSet.cp0 StrictRefEqSet.StrictRefEq_vs_StrongEq], simp_all)


subsubsection‹Execution Rules on Includes›

lemma OclIncludes_charn0[simp]:
assumes val_x:"τ  (υ x)"
shows         "τ  not(Set{}->includesSet(x))"
using val_x
apply(auto simp: OclValid_def OclIncludes_def OclNot_def false_def true_def)
apply(auto simp: mtSet_def Setbase.Abs_Setbase_inverse)
done


lemma OclIncludes_charn0'[simp,code_unfold]:
"Set{}->includesSet(x) = (if υ x then false else invalid endif)"
proof -
  have A: " τ. (Set{}->includesSet(invalid)) τ = (if (υ invalid) then false else invalid endif) τ"
          by simp
  have B: " τ x. τ  (υ x)  (Set{}->includesSet(x)) τ = (if υ x then false else invalid endif) τ"
          apply(frule OclIncludes_charn0, simp add: OclValid_def)
          apply(rule foundation21[THEN fun_cong, simplified StrongEq_def,simplified,
                     THEN iffD1, of _ _ "false"])
          by simp
  show ?thesis
    apply(rule ext, rename_tac τ)
    apply(case_tac "τ  (υ x)")
     apply(simp_all add: B foundation18)
    apply(subst OclIncludes.cp0, simp add: OclIncludes.cp0[symmetric] A)
  done
qed

lemma OclIncludes_charn1:
assumes def_X:"τ  (δ X)"
assumes val_x:"τ  (υ x)"
shows         "τ  (X->includingSet(x)->includesSet(x))"
proof -
 have C : "insert (x τ) Rep_Setbase (X τ)  {X. X = bot  X = null  (xX. x  bot)}"
          by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def)
 show ?thesis
  apply(subst OclIncludes_def, simp add: foundation10[simplified OclValid_def] OclValid_def
                                 def_X[simplified OclValid_def] val_x[simplified OclValid_def])
  apply(simp add: OclIncluding_def def_X[simplified OclValid_def] val_x[simplified OclValid_def]
                  Abs_Setbase_inverse[OF C] true_def)
 done
qed



lemma OclIncludes_charn2:
assumes def_X:"τ  (δ X)"
and     val_x:"τ  (υ x)"
and     val_y:"τ  (υ y)"
and     neq  :"τ  not(x  y)"
shows         "τ  (X->includingSet(x)->includesSet(y))  (X->includesSet(y))"
proof -
 have C : "insert (x τ) Rep_Setbase (X τ)  {X. X = bot  X = null  (xX. x  bot)}"
          by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def)
 show ?thesis
  apply(subst OclIncludes_def,
        simp add: def_X[simplified OclValid_def] val_x[simplified OclValid_def]
                  val_y[simplified OclValid_def] foundation10[simplified OclValid_def]
                  OclValid_def StrongEq_def)
  apply(simp add: OclIncluding_def OclIncludes_def def_X[simplified OclValid_def]
                  val_x[simplified OclValid_def] val_y[simplified OclValid_def]
                  Abs_Setbase_inverse[OF C] true_def)
 by(metis foundation22 foundation6 foundation9 neq)
qed

text‹Here is again a generic theorem similar as above.›

lemma OclIncludes_execute_generic:
assumes strict1: "(invalid  y) = invalid"
and     strict2: "(x  invalid) = invalid"
and     cp_StrictRefEq: " (X::('𝔄,'a::null)val) Y τ. (X  Y) τ = ((λ_. X τ)  (λ_. Y τ)) τ"
and     StrictRefEq_vs_StrongEq: " (x::('𝔄,'a::null)val) y τ.
                                      τ  υ x  τ  υ y  (τ  ((x  y)  (x  y)))"
shows
      "(X->includingSet(x::('𝔄,'a::null)val)->includesSet(y)) =
       (if δ X then if x  y then true else X->includesSet(y) endif else invalid endif)"
proof -
  have A: "τ. τ  (X  invalid) 
            (X->includingSet(x)->includesSet(y)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev,simp,simp)
  have B: "τ. τ  (X  null) 
            (X->includingSet(x)->includesSet(y)) τ = invalid  τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev,simp,simp)

  note [simp] = cp_StrictRefEq [THEN allI[THEN allI[THEN allI[THEN cpI2]], of "StrictRefEq"]]

  have C: "τ. τ  (x  invalid) 
           (X->includingSet(x)->includesSet(y)) τ =
           (if x  y then true else X->includesSet(y) endif) τ"
            apply(rule foundation22[THEN iffD1])
            apply(erule StrongEq_L_subst2_rev,simp,simp)
            by (simp add: strict1)
  have D:"τ. τ  (y  invalid) 
           (X->includingSet(x)->includesSet(y)) τ =
           (if x  y then true else X->includesSet(y) endif) τ"
            apply(rule foundation22[THEN iffD1])
            apply(erule StrongEq_L_subst2_rev,simp,simp)
            by (simp add: strict2)
  have E: "τ. τ  υ x  τ  υ y 
              (if x  y then true else X->includesSet(y) endif) τ =
              (if x  y then true else X->includesSet(y) endif) τ"
           apply(subst cp_OclIf)
           apply(subst StrictRefEq_vs_StrongEq[THEN foundation22[THEN iffD1]])
           by(simp_all add: cp_OclIf[symmetric])
  have F: "τ. τ  (x  y) 
               (X->includingSet(x)->includesSet(y)) τ = (X->includingSet(x)->includesSet(x)) τ"
           apply(rule foundation22[THEN iffD1])
           by(erule StrongEq_L_subst2_rev,simp, simp)
  show ?thesis
    apply(rule ext, rename_tac "τ")
    apply(case_tac "¬ (τ  (δ X))", simp add:defined_split,elim disjE A B)
    apply(case_tac "¬ (τ  (υ x))",
          simp add:foundation18 foundation22[symmetric],
          drule StrongEq_L_sym)
     apply(simp add: foundation22 C)
    apply(case_tac "¬ (τ  (υ y))",
          simp add:foundation18 foundation22[symmetric],
          drule StrongEq_L_sym, simp add: foundation22 D, simp)
    apply(subst E,simp_all)
    apply(case_tac "τ  not(x  y)")
     apply(simp add: OclIncludes_charn2[simplified foundation22])
    apply(simp add: foundation9 F
                    OclIncludes_charn1[THEN foundation13[THEN iffD2],
                                     THEN foundation22[THEN iffD1]])
  done
qed


(* Hack to work around OF-Bug *)
schematic_goal OclIncludes_executeInteger[simp,code_unfold]: "?X"
by(rule OclIncludes_execute_generic[OF StrictRefEqInteger.strict1 StrictRefEqInteger.strict2
                                    StrictRefEqInteger.cp0
                                    StrictRefEqInteger.StrictRefEq_vs_StrongEq], simp_all)


schematic_goal OclIncludes_executeBoolean[simp,code_unfold]: "?X"
by(rule OclIncludes_execute_generic[OF StrictRefEqBoolean.strict1 StrictRefEqBoolean.strict2
                                    StrictRefEqBoolean.cp0
                                    StrictRefEqBoolean.StrictRefEq_vs_StrongEq], simp_all)


schematic_goal OclIncludes_executeSet[simp,code_unfold]: "?X"
by(rule OclIncludes_execute_generic[OF StrictRefEqSet.strict1 StrictRefEqSet.strict2
                                    StrictRefEqSet.cp0
                                    StrictRefEqSet.StrictRefEq_vs_StrongEq], simp_all)

lemma OclIncludes_including_generic :
 assumes OclIncludes_execute_generic [simp] : "X x y.
           (X->includingSet(x::('𝔄,'a::null)val)->includesSet(y)) =
           (if δ X then if x  y then true else X->includesSet(y) endif else invalid endif)"
     and StrictRefEq_strict'' : "x y. δ ((x::('𝔄,'a::null)val)  y) = (υ(x) and υ(y))"
     and a_val : "τ  υ a"
     and x_val : "τ  υ x"
     and S_incl : "τ  (S)->includesSet((x::('𝔄,'a::null)val))"
   shows "τ  S->includingSet((a::('𝔄,'a::null)val))->includesSet(x)"
proof -
 have discr_eq_bot1_true : "τ. ( τ = true τ) = False"
 by (metis bot_fun_def foundation1 foundation18' valid3)
 have discr_eq_bot2_true : "τ. ( = true τ) = False"
 by (metis bot_fun_def discr_eq_bot1_true)
 have discr_neq_invalid_true : "τ. (invalid τ  true τ) = True"
 by (metis discr_eq_bot2_true invalid_def)
 have discr_eq_invalid_true : "τ. (invalid τ = true τ) = False"
 by (metis bot_option_def invalid_def option.simps(2) true_def)
show ?thesis
  apply(simp)
  apply(subgoal_tac "τ  δ S")
   prefer 2
   apply(insert S_incl[simplified OclIncludes_def], simp add:  OclValid_def)
   apply(metis discr_eq_bot2_true)
  apply(simp add: cp_OclIf[of "δ S"] OclValid_def OclIf_def x_val[simplified OclValid_def]
                  discr_neq_invalid_true discr_eq_invalid_true)
 by (metis OclValid_def S_incl StrictRefEq_strict'' a_val foundation10 foundation6 x_val)
qed

lemmas OclIncludes_includingInteger =
       OclIncludes_including_generic[OF OclIncludes_executeInteger StrictRefEqInteger.def_homo]

subsubsection‹Execution Rules on Excludes›

lemma OclExcludes_charn1:
assumes def_X:"τ  (δ X)"
assumes val_x:"τ  (υ x)"
shows         "τ  (X->excludingSet(x)->excludesSet(x))"
proof -
 let ?OclSet = "λS. S  {X. X =   X = null  (xX. x  )}"
 have diff_in_Setbase : "?OclSet (Rep_Setbase (X τ) - {x τ})"
  apply(simp, (rule disjI2)+)
 by (metis (hide_lams, no_types) Diff_iff Set_inv_lemma def_X)

 show ?thesis
  apply(subst OclExcludes_def, simp add: foundation10[simplified OclValid_def] OclValid_def
                                 def_X[simplified OclValid_def] val_x[simplified OclValid_def])
  apply(subst OclIncludes_def, simp add: OclNot_def)
  apply(simp add: OclExcluding_def def_X[simplified OclValid_def] val_x[simplified OclValid_def]
                  Abs_Setbase_inverse[OF diff_in_Setbase] true_def)
 by(simp add: OclAnd_def def_X[simplified OclValid_def] val_x[simplified OclValid_def] true_def)
qed

subsubsection‹Execution Rules on Size›

lemma [simp,code_unfold]: "Set{} ->sizeSet() = 𝟬"
 apply(rule ext)
 apply(simp add: defined_def mtSet_def OclSize_def
                 bot_Setbase_def bot_fun_def
                 null_Setbase_def null_fun_def)
 apply(subst Abs_Setbase_inject, simp_all add: bot_option_def null_option_def) +
by(simp add: Abs_Setbase_inverse bot_option_def null_option_def OclInt0_def)

lemma OclSize_including_exec[simp,code_unfold]:
 "((X ->includingSet(x)) ->sizeSet()) = (if δ X and υ x then
                                     X ->sizeSet() +int if X ->includesSet(x) then 𝟬 else 𝟭 endif
                                   else
                                     invalid
                                   endif)"
proof -

 have valid_inject_true : "τ P. (υ P) τ  true τ  (υ P) τ = false τ"
      apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def
                      null_fun_def null_option_def)
      by (case_tac "P τ = ", simp_all add: true_def)
 have defined_inject_true : "τ P. (δ P) τ  true τ  (δ P) τ = false τ"
      apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
                      null_fun_def null_option_def)
      by (case_tac " P τ =   P τ = null", simp_all add: true_def)

 show ?thesis
  apply(rule ext, rename_tac τ)
  proof -
  fix τ
  have includes_notin: "¬ τ  X->includesSet(x)  (δ X) τ = true τ  (υ x) τ = true τ 
                        x τ  Rep_Setbase (X τ)"
  by(simp add: OclIncludes_def OclValid_def true_def)

  have includes_def: "τ  X->includesSet(x)  τ  δ X"
  by (metis bot_fun_def OclIncludes_def OclValid_def defined3 foundation16)

  have includes_val: "τ  X->includesSet(x)  τ  υ x"
  using foundation5 foundation6 by fastforce

  have ins_in_Setbase: "τ  δ X  τ  υ x 
    insert (x τ) Rep_Setbase (X τ)  {X. X =   X = null  (xX. x  )}"
   apply(simp add: bot_option_def null_option_def)
  by (metis (hide_lams, no_types) Set_inv_lemma foundation18' foundation5)

  have m : "τ. (λ_. ) = (λ_. invalid τ)" by(rule ext, simp add:invalid_def)
  
  show "X->includingSet(x)->sizeSet() τ = (if δ X and υ x
                                     then X->sizeSet() +int if X->includesSet(x) then 𝟬 else 𝟭 endif
                                     else invalid endif) τ"
   apply(case_tac "τ  δ X and υ x", simp)
    apply(subst OclAddInteger.cp0)
    apply(case_tac "τ  X->includesSet(x)", simp add: OclAddInteger.cp0[symmetric])
     apply(case_tac "τ  ((υ (X->sizeSet())) and not (δ (X->sizeSet())))", simp)
      apply(drule foundation5[where P = "υ X->sizeSet()"], erule conjE)
      apply(drule OclSize_infinite)
      apply(frule includes_def, drule includes_val, simp)
      apply(subst OclSize_def, subst OclIncluding_finite_rep_set, assumption+)
     apply (metis (hide_lams, no_types) invalid_def)

     apply(subst OclIf_false',
           metis (hide_lams, no_types) defined5 defined6 defined_and_I defined_not_I
                                       foundation1 foundation9)
    apply(subst cp_OclSize, simp add: OclIncluding_includes0 cp_OclSize[symmetric])
    (* *)
    apply(subst OclIf_false', subst foundation9, auto, simp add: OclSize_def)
    apply(drule foundation5)
    apply(subst (1 2) OclIncluding_finite_rep_set, fast+)
    apply(subst (1 2) cp_OclAnd, subst (1 2) OclAddInteger.cp0, simp)
    apply(rule conjI)
     apply(simp add: OclIncluding_def)
     apply(subst Abs_Setbase_inverse[OF ins_in_Setbase], fast+)
     apply(subst (asm) (2 3) OclValid_def, simp add: OclAddInteger_def OclInt1_def)
     apply(rule impI)
     apply(drule Finite_Set.card.insert[where x = "x τ"])
     apply(rule includes_notin, simp, simp)
     apply (metis Suc_eq_plus1 of_nat_1 of_nat_add)

    apply(subst (1 2) m[of τ], simp only:   OclAddInteger.cp0[symmetric],simp, simp add:invalid_def)
    apply(subst OclIncluding_finite_rep_set, fast+, simp add: OclValid_def)
   (* *)
   apply(subst OclIf_false', metis (hide_lams, no_types) defined6 foundation1 foundation9
                                                         OclExcluding_valid_args_valid'')
  by (metis cp_OclSize foundation18' OclIncluding_valid_args_valid'' invalid_def OclSize_invalid)
 qed
qed

subsubsection‹Execution Rules on IsEmpty›

lemma [simp,code_unfold]: "Set{}->isEmptySet() = true"
by(simp add: OclIsEmpty_def)

lemma OclIsEmpty_including [simp]:
assumes X_def: "τ  δ X"
    and X_finite: "finite Rep_Setbase (X τ)"
    and a_val: "τ  υ a"
shows "X->includingSet(a)->isEmptySet() τ = false τ"
proof -
 have A1 : "τ X. X τ = true τ  X τ = false τ  (X and not X) τ = false τ"
 by (metis (no_types) OclAnd_false1 OclAnd_idem OclImplies_def OclNot3 OclNot_not OclOr_false1
                      cp_OclAnd cp_OclNot deMorgan1 deMorgan2)

 have defined_inject_true : "τ P. (δ P) τ  true τ  (δ P) τ = false τ"
      apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
                      null_fun_def null_option_def)
      by (case_tac " P τ =   P τ = null", simp_all add: true_def)

 have B : "X τ. τ  υ X  X τ  𝟬 τ  (X  𝟬) τ = false τ"
      apply(simp add: foundation22[symmetric] foundation14 foundation9)
      apply(erule StrongEq_L_subst4_rev[THEN iffD2, OF StrictRefEqInteger.StrictRefEq_vs_StrongEq])
      by(simp_all)

 show ?thesis
  apply(simp add: OclIsEmpty_def del: OclSize_including_exec)
  apply(subst cp_OclOr, subst A1)
   apply (metis OclExcludes.def_homo defined_inject_true)
  apply(simp add: cp_OclOr[symmetric] del: OclSize_including_exec)
  apply(rule B,
        rule foundation20,
        metis OclIncluding.def_homo OclIncluding_finite_rep_set X_def X_finite a_val foundation10' size_defined')
  apply(simp add: OclSize_def OclIncluding_finite_rep_set[OF X_def a_val] X_finite OclInt0_def)
 by (metis OclValid_def X_def a_val foundation10 foundation6
           OclIncluding_notempty_rep_set[OF X_def a_val])
qed

subsubsection‹Execution Rules on NotEmpty›

lemma [simp,code_unfold]: "Set{}->notEmptySet() = false"
by(simp add: OclNotEmpty_def)

lemma OclNotEmpty_including [simp,code_unfold]:
assumes X_def: "τ  δ X"
    and X_finite: "finite Rep_Setbase (X τ)"
    and a_val: "τ  υ a"
shows "X->includingSet(a)->notEmptySet() τ = true τ"
 apply(simp add: OclNotEmpty_def)
 apply(subst cp_OclNot, subst OclIsEmpty_including, simp_all add: assms)
by (metis OclNot4 cp_OclNot)

subsubsection‹Execution Rules on Any›

lemma [simp,code_unfold]: "Set{}->anySet() = null"
by(rule ext, simp add: OclANY_def, simp add: false_def true_def)

lemma OclANY_singleton_exec[simp,code_unfold]:
      "(Set{}->includingSet(a))->anySet() = a"
 apply(rule ext, rename_tac τ, simp add: mtSet_def OclANY_def)
 apply(case_tac "τ  υ a")
  apply(simp add: OclValid_def mtSet_defined[simplified mtSet_def]
                  mtSet_valid[simplified mtSet_def] mtSet_rep_set[simplified mtSet_def])
  apply(subst (1 2) cp_OclAnd,
        subst (1 2) OclNotEmpty_including[where X = "Set{}", simplified mtSet_def])
     apply(simp add: mtSet_defined[simplified mtSet_def])
    apply(metis (hide_lams, no_types) finite.emptyI mtSet_def mtSet_rep_set)
   apply(simp add: OclValid_def)
  apply(simp add: OclIncluding_def)
  apply(rule conjI)
   apply(subst (1 2) Abs_Setbase_inverse, simp add: bot_option_def null_option_def)
    apply(simp, metis OclValid_def foundation18')
   apply(simp)
 apply(simp add: mtSet_defined[simplified mtSet_def])
 (* *)
 apply(subgoal_tac "a τ = ")
  prefer 2
  apply(simp add: OclValid_def valid_def bot_fun_def split: if_split_asm)
 apply(simp)
 apply(subst (1 2 3 4) cp_OclAnd,
       simp add: mtSet_defined[simplified mtSet_def] valid_def bot_fun_def)
by(simp add: cp_OclAnd[symmetric], rule impI, simp add: false_def true_def)

subsubsection‹Execution Rules on Forall›

lemma OclForall_mtSet_exec[simp,code_unfold] :"((Set{})->forAllSet(z| P(z))) = true"
apply(simp add: OclForall_def)
apply(subst mtSet_def)+
apply(subst Abs_Setbase_inverse, simp_all add: true_def)+
done


text‹The following rule is a main theorem of our approach: From a denotational definition
that assures consistency, but may be --- as in the case of the @{term "X->forAllSet(x | P x)"} ---
dauntingly complex, we derive operational rules that can serve as a gold-standard for operational
execution, since they may be evaluated in whatever situation and according to whatever strategy.
In the case of @{term "X->forAllSet(x | P x)"}, the operational rule gives immediately a way to
evaluation in any finite (in terms of conventional OCL: denotable) set, although the rule also
holds for the infinite case:

@{term "Integernull ->forAllSet(x | (Integernull ->forAllSet(y | x +int y  y +int x)))"}

or even:

@{term "Integer ->forAllSet(x | (Integer ->forAllSet(y | x +int y  y +int x)))"}

are valid OCL statements in any context $\tau$.
›

theorem OclForall_including_exec[simp,code_unfold] :
        assumes cp0 : "cp P"
        shows         "((S->includingSet(x))->forAllSet(z | P(z))) = (if δ S and υ x
                                                                then P x and (S->forAllSet(z | P(z)))
                                                                else invalid
                                                                endif)"
proof -
   have cp: "τ. P x τ = P (λ_. x τ) τ" by(insert cp0, auto simp: cp_def)

   have cp_eq : "τ v. (P x τ = v) = (P (λ_. x τ) τ = v)" by(subst cp, simp)

   have cp_OclNot_eq : "τ v. (P x τ  v) = (P (λ_. x τ) τ  v)" by(subst cp, simp)

   have insert_in_Setbase : "τ. (τ (δ S))  (τ (υ x)) 
                               insert (x τ) Rep_Setbase (S τ) 
                                 {X. X = bot  X = null  (xX. x  bot)}"
           by(frule Set_inv_lemma, simp add: foundation18 invalid_def)

   have forall_including_invert : "τ f. (f x τ = f (λ _. x τ) τ) 
                                          τ  (δ S and υ x) 
                                          (xRep_Setbase (S->includingSet(x) τ). f (λ_. x) τ) =
                                            (f x τ  (xRep_Setbase (S τ). f (λ_. x) τ))"
           apply(drule foundation5, simp add: OclIncluding_def)
           apply(subst Abs_Setbase_inverse)
           apply(rule insert_in_Setbase, fast+)
           by(simp add: OclValid_def)

   have exists_including_invert : "τ f. (f x τ = f (λ _. x τ) τ) 
                                          τ  (δ S and υ x) 
                                          (xRep_Setbase (S->includingSet(x) τ). f (λ_. x) τ) =
                                            (f x τ  (xRep_Setbase (S τ). f (λ_. x) τ))"
           apply(subst arg_cong[where f = "λx. ¬x",
                                OF forall_including_invert[where f = "λx τ. ¬ (f x τ)"],
                                simplified])
           by simp_all

   have contradict_Rep_Setbase: "τ S f. xRep_Setbase S. f (λ_. x) τ 
                                       (xRep_Setbase S. ¬ (f (λ_. x) τ)) = False"
           by(case_tac "(xRep_Setbase S. ¬ (f (λ_. x) τ)) = True", simp_all)

   have bot_invalid : " = invalid"  by(rule ext, simp add: invalid_def bot_fun_def)

   have bot_invalid2 : "τ.  = invalid τ"  by(simp add: invalid_def)

   have C1 : "τ. P x τ = false τ  (xRep_Setbase (S τ). P (λ_. x) τ = false τ) 
                  τ  (δ S and υ x) 
                  false τ = (P x and OclForall S P) τ"
           apply(simp add: cp_OclAnd[of "P x"])
           apply(elim disjE, simp)
            apply(simp only: cp_OclAnd[symmetric], simp)
           apply(subgoal_tac "OclForall S P τ = false τ")
            apply(simp only: cp_OclAnd[symmetric], simp)
           apply(simp add: OclForall_def)
           apply(fold OclValid_def, simp add:  foundation10')
           done

   have C2 : "τ. τ  (δ S and υ x) 
                  P x τ = null τ  (xRep_Setbase (S τ). P (λ_. x) τ = null τ) 
                  P x τ = invalid τ  (xRep_Setbase (S τ). P (λ_. x) τ = invalid τ) 
                  xRep_Setbase (S->includingSet(x) τ). P (λ_. x) τ  false τ 
                  invalid τ = (P x and OclForall S P) τ"
           apply(subgoal_tac "(δ S)τ = true τ")
            prefer 2 apply(simp add: foundation10', simp add: OclValid_def)
           apply(drule forall_including_invert[of "λ x τ. P x τ  false τ", OF cp_OclNot_eq, THEN iffD1])
            apply(assumption)
           apply(simp add: cp_OclAnd[of "P x"],elim disjE, simp_all)
              apply(simp add: invalid_def null_fun_def null_option_def bot_fun_def bot_option_def)
             apply(subgoal_tac "OclForall S P τ = invalid τ")
              apply(simp only:cp_OclAnd[symmetric],simp,simp add:invalid_def bot_fun_def)
             apply(unfold OclForall_def, simp add: invalid_def false_def bot_fun_def,simp)
            apply(simp add:cp_OclAnd[symmetric],simp)
           apply(erule conjE)
           apply(subgoal_tac "(P x τ = invalid τ)  (P x τ = null τ)  (P x τ = true τ)  (P x τ = false τ)")
            prefer 2 apply(rule bool_split_0)
           apply(elim disjE, simp_all)
            apply(simp only:cp_OclAnd[symmetric],simp)+
           done

   have A : "τ. τ  (δ S and υ x) 
                 OclForall (S->includingSet(x)) P τ = (P x and OclForall S P) τ"
         proof - fix τ
                 assume 0 : "τ  (δ S and υ x)"
                 let ?S = "λocl. P x τ  ocl τ  (xRep_Setbase (S τ). P (λ_. x) τ  ocl τ)"
                 let ?S' = "λocl. xRep_Setbase (S->includingSet(x) τ). P (λ_. x) τ  ocl τ"
                 let ?assms_1 = "?S' null"
                 let ?assms_2 = "?S' invalid"
                 let ?assms_3 = "?S' false"
                 have 4 : "?assms_3  ?S false"
                     apply(subst  forall_including_invert[of "λ x τ. P x τ  false τ",symmetric])
                     by(simp_all add: cp_OclNot_eq 0)
                 have 5 : "?assms_2  ?S invalid"
                     apply(subst  forall_including_invert[of "λ x τ. P x τ  invalid τ",symmetric])
                     by(simp_all add: cp_OclNot_eq 0)
                 have 6 : "?assms_1  ?S null"
                     apply(subst forall_including_invert[of "λ x τ. P x τ  null τ",symmetric])
                     by(simp_all add: cp_OclNot_eq 0)
                 have 7 : "(δ S) τ = true τ"
                     by(insert 0, simp add: foundation10', simp add: OclValid_def)
         show "?thesis τ"
           apply(subst OclForall_def)
           apply(simp add: cp_OclAnd[THEN sym] OclValid_def contradict_Rep_Setbase)
           apply(intro conjI impI,fold OclValid_def)
           apply(simp_all add: exists_including_invert[where f = "λ x τ. P x τ = null τ", OF cp_eq])
           apply(simp_all add: exists_including_invert[where f = "λ x τ. P x τ = invalid τ", OF cp_eq])
           apply(simp_all add: exists_including_invert[where f = "λ x τ. P x τ = false τ", OF cp_eq])
           proof -
              assume 1 : "P x τ = null τ  (xRep_Setbase (S τ). P (λ_. x) τ = null τ)"
              and    2 : ?assms_2
              and    3 : ?assms_3
              show   "null τ = (P x and OclForall S P) τ"
              proof -
                 note 4 = 4[OF 3]
                 note 5 = 5[OF 2]
                 have 6 : "P x τ = null τ  P x τ = true τ"
                     by(metis 4 5 bool_split_0)
                 show ?thesis
                 apply(insert 6, elim disjE)
                  apply(subst cp_OclAnd)
                  apply(simp add: OclForall_def 7 4[THEN conjunct2] 5[THEN conjunct2])
                  apply(simp_all add:cp_OclAnd[symmetric])
                 apply(subst cp_OclAnd, simp_all add:cp_OclAnd[symmetric] OclForall_def)
                 apply(simp add:4[THEN conjunct2] 5[THEN conjunct2] 0[simplified OclValid_def] 7)
                 apply(insert 1, elim disjE, auto)
                 done
              qed
           next
              assume 1 : ?assms_1
              and    2 : "P x τ = invalid τ  (xRep_Setbase (S τ). P (λ_. x) τ = invalid τ)"
              and    3 : ?assms_3
              show   "invalid τ = (P x and OclForall S P) τ"
              proof -
                 note 4 = 4[OF 3]
                 note 6 = 6[OF 1]
                 have 5 : "P x τ = invalid τ  P x τ = true τ"
                     by(metis 4 6 bool_split_0)
                 show ?thesis
                 apply(insert 5, elim disjE)
                  apply(subst cp_OclAnd)
                  apply(simp add: OclForall_def 4[THEN conjunct2] 6[THEN conjunct2] 7)
                  apply(simp_all add:cp_OclAnd[symmetric])
                 apply(subst cp_OclAnd, simp_all add:cp_OclAnd[symmetric] OclForall_def)
                 apply(insert 2, elim disjE, simp add: invalid_def true_def bot_option_def)
                 apply(simp add: 0[simplified OclValid_def] 4[THEN conjunct2] 6[THEN conjunct2] 7)
                 by(auto)
               qed
           next
              assume 1 : ?assms_1
              and    2 : ?assms_2
              and    3 : ?assms_3
              show   "true τ = (P x and OclForall S P) τ"
              proof -
                 note 4 = 4[OF 3]
                 note 5 = 5[OF 2]
                 note 6 = 6[OF 1]
                 have 8 : "P x τ = true τ"
                     by(metis 4 5 6 bool_split_0)
                 show ?thesis
                 apply(subst cp_OclAnd, simp add: 8 cp_OclAnd[symmetric])
                 by(simp add: OclForall_def 4 5 6 7)
              qed
           qed ( simp add: 0
               | rule C1, simp+
               | rule C2, simp add: 0 )+
        qed

   have B : "τ. ¬ (τ  (δ S and υ x)) 
                 OclForall (S->includingSet(x)) P τ = invalid τ"
           apply(rule foundation22[THEN iffD1])
           apply(simp only: foundation10' de_Morgan_conj foundation18'', elim disjE)
            apply(simp add:  defined_split, elim disjE)
             apply(erule StrongEq_L_subst2_rev, simp+)+
           done

   show ?thesis
           apply(rule ext, rename_tac τ)
           apply(simp add: OclIf_def)
           apply(simp add: cp_defined[of "δ S and υ x"] cp_defined[THEN sym])
           apply(intro conjI impI)
           by(auto intro!: A B simp: OclValid_def)
qed




subsubsection‹Execution Rules on Exists›

lemma OclExists_mtSet_exec[simp,code_unfold] :
"((Set{})->existsSet(z | P(z))) = false"
by(simp add: OclExists_def)

lemma OclExists_including_exec[simp,code_unfold] :
 assumes cp: "cp P"
 shows "((S->includingSet(x))->existsSet(z | P(z))) = (if δ S and υ x
                                                 then P x or (S->existsSet(z | P(z)))
                                                 else invalid
                                                 endif)"
 by(simp add: OclExists_def OclOr_def  cp OclNot_inject)


subsubsection‹Execution Rules on Iterate›

lemma OclIterate_empty[simp,code_unfold]: "((Set{})->iterateSet(a; x = A | P a x)) = A"
proof -
 have C : " τ. (δ (λτ. Abs_Setbase {})) τ = true τ"
 by (metis (no_types) defined_def mtSet_def mtSet_defined null_fun_def)
 show ?thesis
      apply(simp add: OclIterate_def mtSet_def Abs_Setbase_inverse valid_def C)
      apply(rule ext, rename_tac τ)
      apply(case_tac "A τ =  τ", simp_all, simp add:true_def false_def bot_fun_def)
      apply(simp add: Abs_Setbase_inverse)
 done
qed

text‹In particular, this does hold for A = null.›

lemma OclIterate_including:
assumes S_finite:    "τ  δ(S->sizeSet())"
and     F_valid_arg: "(υ A) τ = (υ (F a A)) τ"
and     F_commute:   "comp_fun_commute F"
and     F_cp:        " x y τ. F x y τ = F (λ _. x τ) y τ"
shows   "((S->includingSet(a))->iterateSet(a; x =     A | F a x)) τ =
         ((S->excludingSet(a))->iterateSet(a; x = F a A | F a x)) τ"
proof -
 have insert_in_Setbase : "τ. (τ (δ S))  (τ (υ a)) 
    insert (a τ) Rep_Setbase (S τ)  {X. X = bot  X = null  (xX. x  bot)}"
  by(frule Set_inv_lemma, simp add: foundation18 invalid_def)

 have insert_defined : "τ. (τ (δ S))  (τ (υ a)) 
            (δ (λ_. Abs_Setbase insert (a τ) Rep_Setbase (S τ))) τ = true τ"
  apply(subst defined_def)
  apply(simp add: bot_Setbase_def bot_fun_def null_Setbase_def null_fun_def)
  by(subst Abs_Setbase_inject,
     rule insert_in_Setbase, simp_all add: null_option_def bot_option_def)+

 have remove_finite : "finite Rep_Setbase (S τ) 
                       finite ((λa τ. a) ` (Rep_Setbase (S τ) - {a τ}))"
 by(simp)

 have remove_in_Setbase : "τ. (τ (δ S))  (τ (υ a)) 
   Rep_Setbase (S τ) - {a τ}  {X. X = bot  X = null  (xX. x  bot)}"
 by(frule Set_inv_lemma, simp add: foundation18 invalid_def)

 have remove_defined : "τ. (τ (δ S))  (τ (υ a)) 
            (δ (λ_. Abs_Setbase Rep_Setbase (S τ) - {a τ})) τ = true τ"
  apply(subst defined_def)
  apply(simp add: bot_Setbase_def bot_fun_def null_Setbase_def null_fun_def)
  by(subst Abs_Setbase_inject,
     rule remove_in_Setbase, simp_all add: null_option_def bot_option_def)+

 have abs_rep: "x. x  {X. X = bot  X = null  (xX. x  bot)} 
                    Rep_Setbase (Abs_Setbase x) = x"
 by(subst Abs_Setbase_inverse, simp_all)

 have inject : "inj (λa τ. a)"
 by(rule inj_fun, simp)

 show ?thesis
  apply(subst (1 2) cp_OclIterate, subst OclIncluding_def, subst OclExcluding_def)
  apply(case_tac "¬ ((δ S) τ = true τ  (υ a) τ = true τ)", simp add: invalid_def)

   apply(subgoal_tac "OclIterate (λ_. ) A F τ = OclIterate (λ_. ) (F a A) F τ", simp)
    apply(rule conjI, blast+)
  apply(simp add: OclIterate_def defined_def bot_option_def bot_fun_def false_def true_def)

  apply(simp add: OclIterate_def)
  apply((subst abs_rep[OF insert_in_Setbase[simplified OclValid_def], of τ], simp_all)+,
        (subst abs_rep[OF remove_in_Setbase[simplified OclValid_def], of τ], simp_all)+,
        (subst insert_defined, simp_all add: OclValid_def)+,
        (subst remove_defined, simp_all add: OclValid_def)+)

  apply(case_tac "¬ ((υ A) τ = true τ)", (simp add: F_valid_arg)+)
  apply(rule impI,
        subst Finite_Set.comp_fun_commute.fold_fun_left_comm[symmetric, OF F_commute],
        rule remove_finite, simp)

  apply(subst image_set_diff[OF inject], simp)
  apply(subgoal_tac "Finite_Set.fold F A (insert (λτ'. a τ) ((λa τ. a) ` Rep_Setbase (S τ))) τ =
      F (λτ'. a τ) (Finite_Set.fold F A ((λa τ. a) ` Rep_Setbase (S τ) - {λτ'. a τ})) τ")
   apply(subst F_cp, simp)

 by(subst Finite_Set.comp_fun_commute.fold_insert_remove[OF F_commute], simp+)
qed

subsubsection‹Execution Rules on Select›

lemma OclSelect_mtSet_exec[simp,code_unfold]: "OclSelect mtSet P = mtSet"
 apply(rule ext, rename_tac τ)
 apply(simp add: OclSelect_def mtSet_def defined_def false_def true_def
                 bot_Setbase_def bot_fun_def null_Setbase_def null_fun_def)
by(( subst (1 2 3 4 5) Abs_Setbase_inverse
   | subst Abs_Setbase_inject), (simp add: null_option_def bot_option_def)+)+

definition "OclSelect_body :: _  _  _  ('𝔄, 'a option option) Set
            (λP x acc. if P x  false then acc else acc->includingSet(x) endif)"

theorem OclSelect_including_exec[simp,code_unfold]:
 assumes P_cp : "cp P"
 shows "OclSelect (X->includingSet(y)) P = OclSelect_body P y (OclSelect (X->excludingSet(y)) P)"
 (is "_ = ?select")
proof -
 have P_cp: "x τ. P x τ = P (λ_. x τ) τ" by(insert P_cp, auto simp: cp_def)

 have ex_including : "f X y τ. τ  δ X  τ  υ y 
                                   (xRep_Setbase (X->includingSet(y) τ). f (P (λ_. x)) τ) =
                                   (f (P (λ_. y τ)) τ  (xRep_Setbase (X τ). f (P (λ_. x)) τ))"
      apply(simp add: OclIncluding_def OclValid_def)
       apply(subst Abs_Setbase_inverse, simp, (rule disjI2)+)
      by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18',simp)

 have al_including : "f X y τ. τ  δ X  τ  υ y 
                                   (xRep_Setbase (X->includingSet(y) τ). f (P (λ_. x)) τ) =
                                   (f (P (λ_. y τ)) τ  (xRep_Setbase (X τ). f (P (λ_. x)) τ))"
      apply(simp add: OclIncluding_def OclValid_def)
       apply(subst Abs_Setbase_inverse, simp, (rule disjI2)+)
      by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18', simp)

 have ex_excluding1 : "f X y τ. τ  δ X  τ  υ y  ¬ (f (P (λ_. y τ)) τ) 
                                   (xRep_Setbase (X τ). f (P (λ_. x)) τ) =
                                   (xRep_Setbase (X->excludingSet(y) τ). f (P (λ_. x)) τ)"
      apply(simp add: OclExcluding_def OclValid_def)
       apply(subst Abs_Setbase_inverse, simp, (rule disjI2)+)
      by (metis (no_types) Diff_iff OclValid_def Set_inv_lemma) auto

 have al_excluding1 : "f X y τ. τ  δ X  τ  υ y  f (P (λ_. y τ)) τ 
                                   (xRep_Setbase (X τ). f (P (λ_. x)) τ) =
                                   (xRep_Setbase (X->excludingSet(y) τ). f (P (λ_. x)) τ)"
      apply(simp add: OclExcluding_def OclValid_def)
      apply(subst Abs_Setbase_inverse, simp, (rule disjI2)+)
      by (metis (no_types) Diff_iff OclValid_def Set_inv_lemma) auto

 have in_including : "f X y τ. τ  δ X  τ  υ y 
                                  {x  Rep_Setbase (X->includingSet(y) τ). f (P (λ_. x) τ)} =
                                   (let s = {x  Rep_Setbase (X τ). f (P (λ_. x) τ)} in
                                    if f (P (λ_. y τ) τ) then insert (y τ) s else s)"
      apply(simp add: OclIncluding_def OclValid_def)
      apply(subst Abs_Setbase_inverse, simp, (rule disjI2)+)
       apply (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18')
      by(simp add: Let_def, auto)

 let ?OclSet = "λS. S  {X. X =   X = null  (xX. x  )}"

 have diff_in_Setbase : "τ. (δ X) τ = true τ  ?OclSet (Rep_Setbase (X τ) - {y τ})"
      apply(simp, (rule disjI2)+)
      by (metis (mono_tags) Diff_iff OclValid_def Set_inv_lemma)

 have ins_in_Setbase : "τ. (δ X) τ = true τ  (υ y) τ = true τ 
                           ?OclSet (insert (y τ) {x  Rep_Setbase (X τ). P (λ_. x) τ  false τ})"
      apply(simp, (rule disjI2)+)
      by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18')

 have ins_in_Setbase' : "τ. (δ X) τ = true τ  (υ y) τ = true τ 
        ?OclSet (insert (y τ) {x  Rep_Setbase (X τ). x  y τ  P (λ_. x) τ  false τ})"
      apply(simp, (rule disjI2)+)
      by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18')

 have ins_in_Setbase'' : "τ. (δ X) τ = true τ 
        ?OclSet {x  Rep_Setbase (X τ). P (λ_. x) τ  false τ}"
      apply(simp, (rule disjI2)+)
      by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma)

 have ins_in_Setbase''' : "τ. (δ X) τ = true τ 
        ?OclSet {x  Rep_Setbase (X τ). x  y τ  P (λ_. x) τ  false τ}"
      apply(simp, (rule disjI2)+)
      by(metis (hide_lams, no_types) OclValid_def Set_inv_lemma)

 have if_same : "a b c d τ. τ  δ a  b τ = d τ  c τ = d τ 
                             (if a then b else c endif) τ = d τ"
      by(simp add: OclIf_def OclValid_def)

 have invert_including : "P y τ. P τ =   P->includingSet(y) τ = "
      by (metis (hide_lams, no_types) foundation16[THEN iffD1]
                foundation18' OclIncluding_valid_args_valid)

 have exclude_defined : "τ. τ  δ X 
           (δ(λ_. Abs_Setbase {xRep_Setbase (X τ). x  y τ  P (λ_. x) τfalse τ})) τ = true τ"
      apply(subst defined_def,
            simp add: false_def true_def bot_Setbase_def bot_fun_def null_Setbase_def null_fun_def)
      by(subst Abs_Setbase_inject[OF ins_in_Setbase'''[simplified false_def]],
         (simp add: OclValid_def bot_option_def null_option_def)+)+

 have if_eq : "x A B τ. τ  υ x  τ  ((if x  false then A else B endif) 
                                          (if x  false then A else B endif))"
      apply(simp add: StrictRefEqBoolean OclValid_def)
      apply(subst (2) StrongEq_def)
      by(subst cp_OclIf, simp add: cp_OclIf[symmetric] true_def)

 have OclSelect_body_bot: "τ. τ  δ X  τ  υ y  P y τ   
                               (xRep_Setbase (X τ). P (λ_. x) τ = )   = ?select τ"
      apply(drule ex_excluding1[where X2 = X and y2 = y and f2 = "λx τ. x τ = "],
            (simp add: P_cp[symmetric])+)
      apply(subgoal_tac "τ  (  ?select)", simp add: OclValid_def StrongEq_def true_def bot_fun_def)
      apply(simp add: OclSelect_body_def)
      apply(subst StrongEq_L_subst3[OF _ if_eq], simp, metis foundation18')
      apply(simp add: OclValid_def, subst StrongEq_def, subst true_def, simp)
      apply(subgoal_tac "xRep_Setbase (X->excludingSet(y) τ). P (λ_. x) τ =  τ")
       prefer 2 apply (metis bot_fun_def )
       apply(subst if_same[where d5 = ""])
        apply (metis defined7 transform1)
       apply(simp add: OclSelect_def bot_option_def bot_fun_def invalid_def)
      apply(subst invert_including)
      by(simp add: OclSelect_def bot_option_def bot_fun_def invalid_def)+


 have d_and_v_inject : "τ X y. (δ X and υ y) τ  true τ  (δ X and υ y) τ = false τ"
      apply(fold OclValid_def, subst foundation22[symmetric])
      apply(auto simp:foundation10'  defined_split)
        apply(erule StrongEq_L_subst2_rev,simp,simp)
       apply(erule StrongEq_L_subst2_rev,simp,simp)
      by(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2,
                                       THEN StrongEq_L_subst2_rev]],simp,simp)




 have OclSelect_body_bot': "τ. (δ X and υ y) τ  true τ   = ?select τ"
      apply(drule d_and_v_inject)
      apply(simp add: OclSelect_def OclSelect_body_def)
      apply(subst cp_OclIf, subst OclIncluding.cp0, simp add: false_def true_def)
      apply(subst cp_OclIf[symmetric], subst OclIncluding.cp0[symmetric])
      by (metis (lifting, no_types) OclIf_def foundation18 foundation18' invert_including)

 have conj_split2 : "a b c τ. ((a  false) τ = false τ  b)  ((a  false) τ = true τ  c) 
                               (a τ  false τ  b)  (a τ = false τ  c)"
      by (metis OclValid_def defined7 foundation14 foundation22 foundation9)

 have defined_inject_true : "τ P. (δ P) τ  true τ  (δ P) τ = false τ"
      apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
                      null_fun_def null_option_def)
      by (case_tac " P τ =   P τ = null", simp_all add: true_def)

 have cp_OclSelect_body : "τ. ?select τ = OclSelect_body P y (λ_.(OclSelect (X->excludingSet(y))P)τ)τ"
      apply(simp add: OclSelect_body_def)
      by(subst (1 2) cp_OclIf, subst (1 2) OclIncluding.cp0, blast)

 have OclSelect_body_strict1 : "OclSelect_body P y invalid = invalid"
      by(rule ext, simp add: OclSelect_body_def OclIf_def)

 have bool_invalid: "(x::('𝔄)Boolean) y τ. ¬ (τ  υ x)  τ  ((x  y)  invalid)"
      by(simp add: StrictRefEqBoolean OclValid_def StrongEq_def true_def)

 have conj_comm : "p q r. (p  q  r) = ((p  q)  r)" by blast

 have inv_bot : "τ. invalid τ =  τ" by (metis bot_fun_def invalid_def)
 have inv_bot' : "τ. invalid τ = " by (simp add: invalid_def)

 show ?thesis
  apply(rule ext, rename_tac τ)
  apply(subst OclSelect_def)
  apply(case_tac "(δ (X->includingSet(y))) τ = true τ", simp)
   apply(( subst ex_including | subst in_including),
         metis OclValid_def foundation5,
         metis OclValid_def foundation5)+
   apply(simp add: Let_def inv_bot)
   apply(subst (2 4 7 9) bot_fun_def)

   apply(subst (4) false_def, subst (4) bot_fun_def, simp add: bot_option_def P_cp[symmetric])
   (* *)
   apply(case_tac "¬ (τ  (υ P y))")
    apply(subgoal_tac "P y τ  false τ")
     prefer 2
     apply (metis (hide_lams, no_types) foundation1 foundation18' valid4)
    apply(simp)
    (* *)
    apply(subst conj_comm, rule conjI)
     apply(drule_tac y11 = false in bool_invalid)
     apply(simp only: OclSelect_body_def,
           metis OclIf_def OclValid_def defined_def foundation2 foundation22
                 bot_fun_def invalid_def)
    (* *)
    apply(drule foundation5[simplified OclValid_def],
          subst al_including[simplified OclValid_def],
          simp,
          simp)
    apply(simp add: P_cp[symmetric])
    apply (metis bot_fun_def foundation18')

   apply(simp add: foundation18' bot_fun_def OclSelect_body_bot OclSelect_body_bot')
   (* *)
   apply(subst (1 2) al_including, metis OclValid_def foundation5, metis OclValid_def foundation5)
   apply(simp add: P_cp[symmetric], subst (4) false_def, subst (4) bot_option_def, simp)

   apply(simp add: OclSelect_def[simplified inv_bot'] OclSelect_body_def StrictRefEqBoolean)
   apply(subst (1 2 3 4) cp_OclIf,
         subst (1 2 3 4) foundation18'[THEN iffD2, simplified OclValid_def],
         simp,
         simp only: cp_OclIf[symmetric] refl if_True)
   apply(subst (1 2) OclIncluding.cp0, rule conj_split2, simp add: cp_OclIf[symmetric])
   apply(subst (1 2 3 4 5 6 7 8) cp_OclIf[symmetric], simp)
   apply(( subst ex_excluding1[symmetric]
         | subst al_excluding1[symmetric] ),
         metis OclValid_def foundation5,
         metis OclValid_def foundation5,
         simp add: P_cp[symmetric] bot_fun_def)+
   apply(simp add: bot_fun_def)
   apply(subst (1 2) invert_including, simp+)
   (* *)
   apply(rule conjI, blast)
   apply(intro impI conjI)
    apply(subst OclExcluding_def)
    apply(drule foundation5[simplified OclValid_def], simp)
    apply(subst Abs_Setbase_inverse[OF diff_in_Setbase], fast)
    apply(simp add: OclIncluding_def cp_valid[symmetric])
    apply((erule conjE)+, frule exclude_defined[simplified OclValid_def], simp)
    apply(subst Abs_Setbase_inverse[OF ins_in_Setbase'''], simp+)
    apply(subst Abs_Setbase_inject[OF ins_in_Setbase ins_in_Setbase'], fast+)
   (* *)
   apply(simp add: OclExcluding_def)
   apply(simp add: foundation10[simplified OclValid_def])
   apply(subst Abs_Setbase_inverse[OF diff_in_Setbase], simp+)
   apply(subst Abs_Setbase_inject[OF ins_in_Setbase'' ins_in_Setbase'''], simp+)
   apply(subgoal_tac "P (λ_. y τ) τ = false τ")
    prefer 2
    apply(subst P_cp[symmetric], metis OclValid_def foundation22)
   apply(rule equalityI)
    apply(rule subsetI, simp, metis)
   apply(rule subsetI, simp)
  (* *)
  apply(drule defined_inject_true)
  apply(subgoal_tac "¬ (τ  δ X)  ¬ (τ  υ y)")
   prefer 2
   apply (metis OclIncluding.def_homo OclIncluding_valid_args_valid OclIncluding_valid_args_valid'' OclValid_def foundation18 valid1)
  apply(subst cp_OclSelect_body, subst cp_OclSelect, subst OclExcluding_def)
  apply(simp add: OclValid_def false_def true_def, rule conjI, blast)
  apply(simp add: OclSelect_invalid[simplified invalid_def]
                  OclSelect_body_strict1[simplified invalid_def]
                  inv_bot')
 done
qed

subsubsection‹Execution Rules on Reject›

lemma OclReject_mtSet_exec[simp,code_unfold]: "OclReject mtSet P = mtSet"
by(simp add: OclReject_def)

lemma OclReject_including_exec[simp,code_unfold]:
 assumes P_cp : "cp P"
 shows "OclReject (X->includingSet(y)) P = OclSelect_body (not o P) y (OclReject (X->excludingSet(y)) P)"
 apply(simp add: OclReject_def comp_def, rule OclSelect_including_exec)
by (metis  assms cp_intro'(5))

subsubsection‹Execution Rules Combining Previous Operators›

text‹OclIncluding›

(* logical level : *)
lemma OclIncluding_idem0 :
 assumes "τ  δ S"
     and "τ  υ i"
   shows "τ  (S->includingSet(i)->includingSet(i)  (S->includingSet(i)))"
by(simp add: OclIncluding_includes OclIncludes_charn1 assms)

(* Pure algebraic level *)
theorem OclIncluding_idem[simp,code_unfold]: "((S :: ('𝔄,'a::null)Set)->includingSet(i)->includingSet(i) = (S->includingSet(i)))"
proof -
  have A: " τ.   τ  (i  invalid)    (S->includingSet(i)->includingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have A':" τ.   τ  (i  invalid)    (S->includingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have C: " τ.   τ  (S  invalid)    (S->includingSet(i)->includingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have C': " τ.  τ  (S  invalid)    (S->includingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have D: " τ.   τ  (S  null)    (S->includingSet(i)->includingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have D': " τ.  τ  (S  null)    (S->includingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  show ?thesis
    apply(rule ext, rename_tac τ)
    apply(case_tac "τ  (υ i)")
     apply(case_tac "τ  (δ S)")
      apply(simp only: OclIncluding_idem0[THEN foundation22[THEN iffD1]])
      apply(simp add: foundation16', elim disjE)
      apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]])
     apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]])
   apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]])
  done
qed

text‹OclExcluding›

(* logical level : *)
lemma OclExcluding_idem0 :
 assumes "τ  δ S"
     and "τ  υ i"
   shows "τ  (S->excludingSet(i)->excludingSet(i)  (S->excludingSet(i)))"
by(simp add: OclExcluding_excludes OclExcludes_charn1 assms)

(* Pure algebraic level *)
theorem OclExcluding_idem[simp,code_unfold]: "((S->excludingSet(i))->excludingSet(i)) = (S->excludingSet(i))"
proof -
  have A: " τ.   τ  (i  invalid)    (S->excludingSet(i)->excludingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have A':" τ.   τ  (i  invalid)    (S->excludingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have C: " τ.   τ  (S  invalid)    (S->excludingSet(i)->excludingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have C': " τ.  τ  (S  invalid)    (S->excludingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have D: " τ.   τ  (S  null)    (S->excludingSet(i)->excludingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  have D': " τ.  τ  (S  null)    (S->excludingSet(i)) τ = invalid τ"
            apply(rule foundation22[THEN iffD1])
            by(erule StrongEq_L_subst2_rev, simp,simp)
  show ?thesis
    apply(rule ext, rename_tac τ)
    apply(case_tac "τ  (υ i)")
     apply(case_tac "τ  (δ S)")
      apply(simp only: OclExcluding_idem0[THEN foundation22[THEN iffD1]])
      apply(simp add: foundation16', elim disjE)
      apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]])
     apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]])
   apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]])
  done
qed

text‹OclIncludes›


lemma OclIncludes_any[simp,code_unfold]:
      "X->includesSet(X->anySet()) = (if δ X then
                                  if δ (X->sizeSet()) then not(X->isEmptySet())
                                  else X->includesSet(null) endif
                                else invalid endif)"
proof -
 have defined_inject_true : "τ P. (δ P) τ  true τ  (δ P) τ = false τ"
      apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
                      null_fun_def null_option_def)
      by (case_tac " P τ =   P τ = null", simp_all add: true_def)

 have valid_inject_true : "τ P. (υ P) τ  true τ  (υ P) τ = false τ"
      apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def
                      null_fun_def null_option_def)
      by (case_tac "P τ = ", simp_all add: true_def)



 have notempty': "τ X. τ  δ X  finite Rep_Setbase (X τ)  not (X->isEmptySet()) τ  true τ 
                        X τ = Set{} τ"
  apply(case_tac "X τ", rename_tac X', simp add: mtSet_def Abs_Setbase_inject)
  apply(erule disjE, metis (hide_lams, mono_tags) bot_Setbase_def bot_option_def foundation16)
  apply(erule disjE, metis (hide_lams, no_types) bot_option_def
                                                 null_Setbase_def null_option_def foundation16[THEN iffD1])
  apply(case_tac X', simp, metis (hide_lams, no_types) bot_Setbase_def foundation16[THEN iffD1])
  apply(rename_tac X'', case_tac X'', simp)
   apply (metis (hide_lams, no_types) foundation16[THEN iffD1] null_Setbase_def)
  apply(simp add: OclIsEmpty_def OclSize_def)
  apply(subst (asm) cp_OclNot, subst (asm) cp_OclOr, subst (asm) StrictRefEqInteger.cp0,
        subst (asm) cp_OclAnd, subst (asm) cp_OclNot)
  apply(simp only: OclValid_def foundation20[simplified OclValid_def]
                   cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric])
  apply(simp add: Abs_Setbase_inverse split: if_split_asm)
 by(simp add: true_def OclInt0_def OclNot_def StrictRefEqInteger StrongEq_def)

 have B: "X τ. ¬ finite Rep_Setbase (X τ)  (δ (X->sizeSet())) τ = false τ"
  apply(subst cp_defined)
  apply(simp add: OclSize_def)
 by (metis bot_fun_def defined_def)

 show ?thesis
  apply(rule ext, rename_tac τ, simp only: OclIncludes_def OclANY_def)
  apply(subst cp_OclIf, subst (2) cp_valid)
  apply(case_tac "(δ X) τ = true τ",
        simp only: foundation20[simplified OclValid_def] cp_OclIf[symmetric], simp,
        subst (1 2) cp_OclAnd, simp add: cp_OclAnd[symmetric])
   apply(case_tac "finite Rep_Setbase (X τ)")
    apply(frule size_defined'[THEN iffD2, simplified OclValid_def], assumption)
    apply(subst (1 2 3 4) cp_OclIf, simp)
    apply(subst (1 2 3 4) cp_OclIf[symmetric], simp)
    apply(case_tac "(X->notEmptySet()) τ = true τ", simp)
     apply(frule OclNotEmpty_has_elt[simplified OclValid_def], simp)
     apply(simp add: OclNotEmpty_def cp_OclIf[symmetric])
     apply(subgoal_tac "(SOME y. y  Rep_Setbase (X τ))  Rep_Setbase (X τ)", simp add: true_def)
      apply(metis OclValid_def Set_inv_lemma foundation18' null_option_def true_def)
     apply(rule someI_ex, simp)
    apply(simp add: OclNotEmpty_def cp_valid[symmetric])
    apply(subgoal_tac "¬ (null τ  Rep_Setbase (X τ))", simp)
     apply(subst OclIsEmpty_def, simp add: OclSize_def)
     apply(subst cp_OclNot, subst cp_OclOr, subst StrictRefEqInteger.cp0, subst cp_OclAnd,
           subst cp_OclNot, simp add: OclValid_def foundation20[simplified OclValid_def]
                                      cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric])
     apply(frule notempty'[simplified OclValid_def],
           (simp add: mtSet_def Abs_Setbase_inverse OclInt0_def false_def)+)
    apply(drule notempty'[simplified OclValid_def], simp, simp)
    apply (metis (hide_lams, no_types) empty_iff mtSet_rep_set)
   (* *)
   apply(frule B)
   apply(subst (1 2 3 4) cp_OclIf, simp)
   apply(subst (1 2 3 4) cp_OclIf[symmetric], simp)
   apply(case_tac "(X->notEmptySet()) τ = true τ", simp)
    apply(frule OclNotEmpty_has_elt[simplified OclValid_def], simp)
    apply(simp add: OclNotEmpty_def OclIsEmpty_def)
    apply(subgoal_tac "X->sizeSet() τ = ")
     prefer 2
     apply (metis (hide_lams, no_types) OclSize_def)
    apply(subst (asm) cp_OclNot, subst (asm) cp_OclOr, subst (asm) StrictRefEqInteger.cp0,
          subst (asm) cp_OclAnd, subst (asm) cp_OclNot)
    apply(simp add: OclValid_def foundation20[simplified OclValid_def]
                    cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric])
    apply(simp add: OclNot_def StrongEq_def StrictRefEqInteger valid_def false_def true_def
                    bot_option_def bot_fun_def invalid_def)

   apply (metis bot_fun_def null_fun_def null_is_valid valid_def)
 by(drule defined_inject_true,
    simp add: false_def true_def OclIf_false[simplified false_def] invalid_def)
qed

text‹OclSize›

lemma [simp,code_unfold]: "δ (Set{} ->sizeSet()) = true"
by simp


lemma [simp,code_unfold]: "δ ((X ->includingSet(x)) ->sizeSet()) = (δ(X->sizeSet()) and υ(x))"
proof -
 have defined_inject_true : "τ P. (δ P) τ  true τ  (δ P) τ = false τ"
      apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
                      null_fun_def null_option_def)
      by (case_tac " P τ =   P τ = null", simp_all add: true_def)

 have valid_inject_true : "τ P. (υ P) τ  true τ  (υ P) τ = false τ"
      apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def
                      null_fun_def null_option_def)
      by (case_tac "P τ = ", simp_all add: true_def)

 have OclIncluding_finite_rep_set : "τ. (δ X and υ x) τ = true τ 
                 finite Rep_Setbase (X->includingSet(x) τ) = finite Rep_Setbase (X τ)"
  apply(rule OclIncluding_finite_rep_set)
 by(metis OclValid_def foundation5)+

 have card_including_exec : "τ. (δ (λ_. int (card Rep_Setbase (X->includingSet(x) τ)))) τ =
                                 (δ (λ_. int (card Rep_Setbase (X τ)))) τ"
 by(simp add: defined_def bot_fun_def bot_option_def null_fun_def null_option_def)

 show ?thesis
  apply(rule ext, rename_tac τ)
  apply(case_tac "(δ (X->includingSet(x)->sizeSet())) τ = true τ", simp del: OclSize_including_exec)
   apply(subst cp_OclAnd, subst cp_defined, simp only: cp_defined[of "X->includingSet(x)->sizeSet()"],
         simp add: OclSize_def)
   apply(case_tac "((δ X and υ x) τ = true τ  finite Rep_Setbase (X->includingSet(x) τ))", simp)
    apply(erule conjE,
          simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec
                    cp_OclAnd[of "δ X" "υ x"]
                    cp_OclAnd[of "true", THEN sym])
    apply(subgoal_tac "(δ X) τ = true τ  (υ x) τ = true τ", simp)
    apply(rule foundation5[of _ "δ X" "υ x", simplified OclValid_def],
          simp only: cp_OclAnd[THEN sym])
   apply(simp, simp add: defined_def true_def false_def bot_fun_def bot_option_def)

  apply(drule defined_inject_true[of "X->includingSet(x)->sizeSet()"],
        simp del: OclSize_including_exec,
        simp only: cp_OclAnd[of "δ (X->sizeSet())" "υ x"],
        simp add: cp_defined[of "X->includingSet(x)->sizeSet()" ] cp_defined[of "X->sizeSet()" ]
             del: OclSize_including_exec,
        simp add: OclSize_def card_including_exec
             del: OclSize_including_exec)
  apply(case_tac "(δ X and υ x) τ = true τ  finite Rep_Setbase (X τ)",
        simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec,
        simp only: cp_OclAnd[THEN sym],
        simp add: defined_def bot_fun_def)

  apply(split if_split_asm)
   apply(simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec)+
  apply(simp only: cp_OclAnd[THEN sym], simp, rule impI, erule conjE)
  apply(case_tac "(υ x) τ = true τ", simp add: cp_OclAnd[of "δ X" "υ x"])
 by(drule valid_inject_true[of "x"], simp add: cp_OclAnd[of _ "υ x"])
qed

lemma [simp,code_unfold]: "δ ((X ->excludingSet(x)) ->sizeSet()) = (δ(X->sizeSet()) and υ(x))"
proof -
 have defined_inject_true : "τ P. (δ P) τ  true τ  (δ P) τ = false τ"
      apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
                      null_fun_def null_option_def)
      by (case_tac " P τ =   P τ = null", simp_all add: true_def)

 have valid_inject_true : "τ P. (υ P) τ  true τ  (υ P) τ = false τ"
      apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def
                      null_fun_def null_option_def)
      by (case_tac "P τ = ", simp_all add: true_def)

 have OclExcluding_finite_rep_set : "τ. (δ X and υ x) τ = true τ 
                                     finite Rep_Setbase (X->excludingSet(x) τ) =
                                     finite Rep_Setbase (X τ)"
  apply(rule OclExcluding_finite_rep_set)
 by(metis OclValid_def foundation5)+

 have card_excluding_exec : "τ. (δ (λ_. int (card Rep_Setbase (X->excludingSet(x) τ)))) τ =
                                   (δ (λ_. int (card Rep_Setbase (X τ)))) τ"
 by(simp add: defined_def bot_fun_def bot_option_def null_fun_def null_option_def)

 show ?thesis
  apply(rule ext, rename_tac τ)
  apply(case_tac "(δ (X->excludingSet(x)->sizeSet())) τ = true τ", simp)
   apply(subst cp_OclAnd, subst cp_defined, simp only: cp_defined[of "X->excludingSet(x)->sizeSet()"],
         simp add: OclSize_def)
   apply(case_tac "((δ X and υ x) τ = true τ  finite Rep_Setbase (X->excludingSet(x) τ))", simp)
    apply(erule conjE,
          simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec
                    cp_OclAnd[of "δ X" "υ x"]
                    cp_OclAnd[of "true", THEN sym])
    apply(subgoal_tac "(δ X) τ = true τ  (υ x) τ = true τ", simp)
    apply(rule foundation5[of _ "δ X" "υ x", simplified OclValid_def],
          simp only: cp_OclAnd[THEN sym])
   apply(simp, simp add: defined_def true_def false_def bot_fun_def bot_option_def)

  apply(drule defined_inject_true[of "X->excludingSet(x)->sizeSet()"],
        simp,
        simp only: cp_OclAnd[of "δ (X->sizeSet())" "υ x"],
        simp add: cp_defined[of "X->excludingSet(x)->sizeSet()" ] cp_defined[of "X->sizeSet()" ],
        simp add: OclSize_def card_excluding_exec)
  apply(case_tac "(δ X and υ x) τ = true τ  finite Rep_Setbase (X τ)",
        simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec,
        simp only: cp_OclAnd[THEN sym],
        simp add: defined_def bot_fun_def)

  apply(split if_split_asm)
   apply(simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec)+
  apply(simp only: cp_OclAnd[THEN sym], simp, rule impI, erule conjE)
  apply(case_tac "(υ x) τ = true τ", simp add: cp_OclAnd[of "δ X" "υ x"])
 by(drule valid_inject_true[of "x"], simp add: cp_OclAnd[of _ "υ x"])
qed

lemma [simp]:
 assumes X_finite: "τ. finite Rep_Setbase (X τ)"
 shows "δ ((X ->includingSet(x)) ->sizeSet()) = (δ(X) and υ(x))"
by(simp add: size_defined[OF X_finite] del: OclSize_including_exec)


text‹OclForall›

lemma OclForall_rep_set_false:
 assumes "τ  δ X"
 shows "(OclForall X P τ = false τ) = (x  Rep_Setbase (X τ). P (λτ. x) τ = false τ)"
by(insert assms, simp add: OclForall_def OclValid_def false_def true_def invalid_def
                           bot_fun_def bot_option_def null_fun_def null_option_def)

lemma OclForall_rep_set_true:
 assumes "τ  δ X"
 shows "(τ  OclForall X P) = (x  Rep_Setbase (X τ). τ  P (λτ. x))"
proof -
 have destruct_ocl : "x τ. x = true τ  x = false τ  x = null τ  x =  τ"
  apply(case_tac x) apply (metis bot_Boolean_def)
  apply(rename_tac x', case_tac x') apply (metis null_Boolean_def)
  apply(rename_tac x'', case_tac x'') apply (metis (full_types) true_def)
 by (metis (full_types) false_def)

 have disjE4 : " P1 P2 P3 P4 R.
   (P1  P2  P3  P4)  (P1  R)  (P2  R)  (P3  R)  (P4  R)  R"
 by metis
 show ?thesis
  apply(simp add: OclForall_def OclValid_def true_def false_def invalid_def
                  bot_fun_def bot_option_def null_fun_def null_option_def split: if_split_asm)
  apply(rule conjI, rule impI) apply (metis drop.simps option.distinct(1) invalid_def)
  apply(rule impI, rule conjI, rule impI) apply (metis option.distinct(1))
  apply(rule impI, rule conjI, rule impI) apply (metis drop.simps)
  apply(intro conjI impI ballI)
   proof - fix x show "xRep_Setbase (X τ). P (λ_. x) τ  None 
                       xRep_Setbase (X τ). y. P (λ_. x) τ = y 
                       xRep_Setbase (X τ). P (λ_. x) τ  False 
                       x  Rep_Setbase (X τ)  P (λτ. x) τ = True"
   apply(erule_tac x = x in ballE)+
   by(rule disjE4[OF destruct_ocl[of "P (λτ. x) τ"]],
      (simp add: true_def false_def null_fun_def null_option_def bot_fun_def bot_option_def)+)
 qed(simp add: assms[simplified OclValid_def true_def])+
qed

lemma OclForall_includes :
 assumes x_def : "τ  δ x"
     and y_def : "τ  δ y"
   shows "(τ  OclForall x (OclIncludes y)) = (Rep_Setbase (x τ)  Rep_Setbase (y τ))"
 apply(simp add: OclForall_rep_set_true[OF x_def],
       simp add: OclIncludes_def OclValid_def y_def[simplified OclValid_def])
 apply(insert Set_inv_lemma[OF x_def], simp add: valid_def false_def true_def bot_fun_def)
by(rule iffI, simp add: subsetI, simp add: subsetD)

lemma OclForall_not_includes :
 assumes x_def : "τ  δ x"
     and y_def : "τ  δ y"
   shows "(OclForall x (OclIncludes y) τ = false τ) = (¬ Rep_Setbase (x τ)  Rep_Setbase (y τ))"
 apply(simp add: OclForall_rep_set_false[OF x_def],
       simp add: OclIncludes_def OclValid_def y_def[simplified OclValid_def])
 apply(insert Set_inv_lemma[OF x_def], simp add: valid_def false_def true_def bot_fun_def)
by(rule iffI, metis rev_subsetD, metis subsetI)

lemma OclForall_iterate:
 assumes S_finite: "finite Rep_Setbase (S τ)"
   shows "S->forAllSet(x | P x) τ = (S->iterateSet(x; acc = true | acc and P x)) τ"
proof -
 have and_comm : "comp_fun_commute (λx acc. acc and P x)"
  apply(simp add: comp_fun_commute_def comp_def)
 by (metis OclAnd_assoc OclAnd_commute)

 have ex_insert : "x F P. (xinsert x F. P x) = (P x  (xF. P x))"
 by (metis insert_iff)

 have destruct_ocl : "x τ. x = true τ  x = false τ  x = null τ  x =  τ"
  apply(case_tac x) apply (metis bot_Boolean_def)
  apply(rename_tac x', case_tac x') apply (metis null_Boolean_def)
  apply(rename_tac x'', case_tac x'') apply (metis (full_types) true_def)
 by (metis (full_types) false_def)

 have disjE4 : " P1 P2 P3 P4 R.
   (P1  P2  P3  P4)  (P1  R)  (P2  R)  (P3  R)  (P4  R)  R"
 by metis

 let ?P_eq = "λx b τ. P (λ_. x) τ = b τ"
 let ?P = "λset b τ. xset. ?P_eq x b τ"
 let ?if = "λf b c. if f b τ then b τ else c"
 let ?forall = "λP. ?if P false (?if P invalid (?if P null (true τ)))"
 show ?thesis
  apply(simp only: OclForall_def OclIterate_def)
  apply(case_tac "τ  δ S", simp only: OclValid_def)
   apply(subgoal_tac "let set = Rep_Setbase (S τ) in
                      ?forall (?P set) =
                      Finite_Set.fold (λx acc. acc and P x) true ((λa τ. a) ` set) τ",
         simp only: Let_def, simp add: S_finite, simp only: Let_def)
   apply(case_tac "Rep_Setbase (S τ) = {}", simp)
   apply(rule finite_ne_induct[OF S_finite], simp)
    (* *)
    apply(simp only: image_insert)
    apply(subst comp_fun_commute.fold_insert[OF and_comm], simp)
     apply (metis empty_iff image_empty)
    apply(simp add: invalid_def)
    apply (metis bot_fun_def destruct_ocl null_fun_def)
   (* *)
   apply(simp only: image_insert)
   apply(subst comp_fun_commute.fold_insert[OF and_comm], simp)
    apply (metis (mono_tags) imageE)

   (* *)
   apply(subst cp_OclAnd) apply(drule sym, drule sym, simp only:, drule sym, simp only:)
   apply(simp only: ex_insert)
   apply(subgoal_tac "x. xF") prefer 2
    apply(metis all_not_in_conv)
   proof - fix x F show "(δ S) τ = true τ  x. x  F 
            ?forall (λb τ. ?P_eq x b τ  ?P F b τ) =
            ((λ_. ?forall (?P F)) and (λ_. P (λτ. x) τ)) τ"
    apply(rule disjE4[OF destruct_ocl[where x1 = "P (λτ. x) τ"]])
       apply(simp_all add: true_def false_def invalid_def OclAnd_def
                           null_fun_def null_option_def bot_fun_def bot_option_def)
   by (metis (lifting) option.distinct(1))+
 qed(simp add: OclValid_def)+
qed

lemma OclForall_cong:
 assumes "x. x  Rep_Setbase (X τ)  τ  P (λτ. x)  τ  Q (λτ. x)"
 assumes P: "τ  OclForall X P"
 shows "τ  OclForall X Q"
proof -
 have def_X: "τ  δ X"
 by(insert P, simp add: OclForall_def OclValid_def bot_option_def true_def split: if_split_asm)
 show ?thesis
  apply(insert P)
  apply(subst (asm) OclForall_rep_set_true[OF def_X], subst OclForall_rep_set_true[OF def_X])
 by (simp add: assms)
qed

lemma OclForall_cong':
 assumes "x. x  Rep_Setbase (X τ)  τ  P (λτ. x)  τ  Q (λτ. x)  τ  R (λτ. x)"
 assumes P: "τ  OclForall X P"
 assumes Q: "τ  OclForall X Q"
 shows "τ  OclForall X R"
proof -
 have def_X: "τ  δ X"
 by(insert P, simp add: OclForall_def OclValid_def bot_option_def true_def split: if_split_asm)
 show ?thesis
  apply(insert P Q)
  apply(subst (asm) (1 2) OclForall_rep_set_true[OF def_X], subst OclForall_rep_set_true[OF def_X])
 by (simp add: assms)
qed

text‹Strict Equality›

lemma StrictRefEqSet_defined :
 assumes x_def: "τ  δ x"
 assumes y_def: "τ  δ y"
 shows "((x::('𝔄,::null)Set)  y) τ =
                (x->forAllSet(z| y->includesSet(z)) and (y->forAllSet(z| x->includesSet(z)))) τ"
proof -
 have rep_set_inj : "τ. (δ x) τ = true τ 
                         (δ y) τ = true τ 
                          x τ  y τ 
                          Rep_Setbase (y τ)  Rep_Setbase (x τ)"
  apply(simp add: defined_def)
  apply(split if_split_asm, simp add: false_def true_def)+
  apply(simp add: null_fun_def null_Setbase_def bot_fun_def bot_Setbase_def)

  apply(case_tac "x τ", rename_tac x')
  apply(case_tac x', simp_all, rename_tac x'')
  apply(case_tac x'', simp_all)

  apply(case_tac "y τ", rename_tac y')
  apply(case_tac y', simp_all, rename_tac y'')
  apply(case_tac y'', simp_all)

  apply(simp add: Abs_Setbase_inverse)
 by(blast)

 show ?thesis
  apply(simp add: StrictRefEqSet StrongEq_def
    foundation20[OF x_def, simplified OclValid_def]
    foundation20[OF y_def, simplified OclValid_def])
  apply(subgoal_tac "x τ = y τ = true τ  x τ = y τ = false τ")
   prefer 2
   apply(simp add: false_def true_def)
  (* *)
  apply(erule disjE)
   apply(simp add: true_def)

   apply(subgoal_tac "(τ  OclForall x (OclIncludes y))  (τ  OclForall y (OclIncludes x))")
    apply(subst cp_OclAnd, simp add: true_def OclValid_def)
   apply(simp add: OclForall_includes[OF x_def y_def]
                   OclForall_includes[OF y_def x_def])

  (* *)
  apply(simp)

  apply(subgoal_tac "OclForall x (OclIncludes y) τ = false τ 
                     OclForall y (OclIncludes x) τ = false τ")
   apply(subst cp_OclAnd, metis OclAnd_false1 OclAnd_false2 cp_OclAnd)
  apply(simp only: OclForall_not_includes[OF x_def y_def, simplified OclValid_def]
                   OclForall_not_includes[OF y_def x_def, simplified OclValid_def],
        simp add: false_def)
 by (metis OclValid_def rep_set_inj subset_antisym x_def y_def)
qed

lemma StrictRefEqSet_exec[simp,code_unfold] :
"((x::('𝔄,::null)Set)  y) =
  (if δ x then (if δ y
                then ((x->forAllSet(z| y->includesSet(z)) and (y->forAllSet(z| x->includesSet(z)))))
                else if υ y
                      then false ― ‹x'->includes = null›
                      else invalid
                      endif
                endif)
         else if υ x ― ‹null = ???›
              then if υ y then not(δ y) else invalid endif
              else invalid
              endif
         endif)"
proof -
 have defined_inject_true : "τ P. (¬ (τ  δ P)) = ((δ P) τ = false τ)"
 by (metis bot_fun_def OclValid_def defined_def foundation16 null_fun_def)

 have valid_inject_true : "τ P. (¬ (τ  υ P)) = ((υ P) τ = false τ)"
 by (metis bot_fun_def OclIf_true' OclIncludes_charn0 OclIncludes_charn0' OclValid_def valid_def
           foundation6 foundation9)
 show ?thesis
  apply(rule ext, rename_tac τ)
  (* *)
  apply(simp add: OclIf_def
                  defined_inject_true[simplified OclValid_def]
                  valid_inject_true[simplified OclValid_def],
        subst false_def, subst true_def, simp)
  apply(subst (1 2) cp_OclNot, simp, simp add: cp_OclNot[symmetric])
  apply(simp add: StrictRefEqSet_defined[simplified OclValid_def])
 by(simp add: StrictRefEqSet StrongEq_def false_def true_def valid_def defined_def)
qed

lemma StrictRefEqSet_L_subst1 : "cp P  τ  υ x  τ  υ y  τ  υ P x  τ  υ P y 
    τ  (x::('𝔄,::null)Set)  y  τ  (P x ::('𝔄,::null)Set)  P y"
 apply(simp only: StrictRefEqSet OclValid_def)
 apply(split if_split_asm)
  apply(simp add: StrongEq_L_subst1[simplified OclValid_def])
by (simp add: invalid_def bot_option_def true_def)

lemma OclIncluding_cong' :
shows "τ  δ s  τ  δ t  τ  υ x 
    τ  ((s::('𝔄,'a::null)Set)  t)  τ  (s->includingSet(x)  (t->includingSet(x)))"
proof -
 have cp: "cp (λs. (s->includingSet(x)))"
  apply(simp add: cp_def, subst OclIncluding.cp0)
 by (rule_tac x = "(λxab ab. ((λ_. xab)->includingSet(λ_. x ab)) ab)" in exI, simp)

 show "τ  δ s  τ  δ t  τ  υ x  τ  (s  t)  ?thesis"
  apply(rule_tac P = "λs. (s->includingSet(x))" in StrictRefEqSet_L_subst1)
       apply(rule cp)
      apply(simp add: foundation20) apply(simp add: foundation20)
    apply (simp add: foundation10 foundation6)+
 done
qed

lemma OclIncluding_cong : "(s::('𝔄,'a::null)Set) t x y τ. τ  δ t  τ  υ y 
                             τ  s  t  x = y  τ  s->includingSet(x)  (t->includingSet(y))"
 apply(simp only:)
 apply(rule OclIncluding_cong', simp_all only:)
by(auto simp: OclValid_def OclIf_def invalid_def bot_option_def OclNot_def split : if_split_asm)

(* < *)
lemma const_StrictRefEqSet_empty : "const X   const (X  Set{})" 
 apply(rule StrictRefEqSet.const, assumption)
by(simp)

lemma const_StrictRefEqSet_including : 
 "const a  const S  const X   const (X  S->includingSet(a))"
 apply(rule StrictRefEqSet.const, assumption)
by(rule const_OclIncluding)

subsection‹Test Statements›

Assert   "(τ  (Set{λ_. x}  Set{λ_. x}))"
Assert   "(τ  (Set{λ_. x}  Set{λ_. x}))"

instantiation Setbase  :: (equal)equal
begin
  definition "HOL.equal k l   (k::('a::equal)Setbase) =  l"
  instance   by standard (rule equal_Setbase_def)
end

lemma equal_Setbase_code [code]:
  "HOL.equal k (l::('a::{equal,null})Setbase)  Rep_Setbase k = Rep_Setbase l"
  by (auto simp add: equal Setbase.Rep_Setbase_inject)

Assert   "τ  (Set{}  Set{})" 
Assert   "τ  (Set{𝟭,𝟮}  Set{}->includingSet(𝟮)->includingSet(𝟭))" 
Assert   "τ  (Set{𝟭,invalid,𝟮}  invalid)"
Assert   "τ  (Set{𝟭,𝟮}->includingSet(null)  Set{null,𝟭,𝟮})"
Assert   "τ  (Set{𝟭,𝟮}->includingSet(null)  Set{𝟭,𝟮,null})"

(*
Assert   "¬ (τ ⊨ (Set{𝟭,𝟭,𝟮} ≐ Set{𝟭,𝟮}))"
Assert   "¬ (τ ⊨ (Set{𝟭,𝟮} ≐ Set{𝟮,𝟭}))"
*)

(* > *)

end

Theory UML_Sequence

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Sequence.thy --- Library definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)


theory  UML_Sequence
imports "../basic_types/UML_Boolean"
        "../basic_types/UML_Integer"
begin

no_notation None ("")
section‹Collection Type Sequence: Operations›

subsection‹Basic Properties of the Sequence Type›

text‹Every element in a defined sequence is valid.›

lemma Sequence_inv_lemma: "τ  (δ X)  xset Rep_Sequencebase (X τ). x  bot"
apply(insert Rep_Sequencebase [of "X τ"], simp)
apply(auto simp: OclValid_def defined_def false_def true_def cp_def
                 bot_fun_def bot_Sequencebase_def null_Sequencebase_def null_fun_def
           split:if_split_asm)
 apply(erule contrapos_pp [of "Rep_Sequencebase (X τ) = bot"])
 apply(subst Abs_Sequencebase_inject[symmetric], rule Rep_Sequencebase, simp)
 apply(simp add: Rep_Sequencebase_inverse bot_Sequencebase_def bot_option_def)
apply(erule contrapos_pp [of "Rep_Sequencebase (X τ) = null"])
apply(subst Abs_Sequencebase_inject[symmetric], rule Rep_Sequencebase, simp)
apply(simp add: Rep_Sequencebase_inverse  null_option_def)
by (simp add: bot_option_def)

subsection‹Definition: Strict Equality \label{sec:seq-strict-equality}›

text‹After the part of foundational operations on sets, we detail here equality on sets.
Strong equality is inherited from the OCL core, but we have to consider
the case of the strict equality. We decide to overload strict equality in the
same way we do for other value's in OCL:›

overloading
  StrictRefEq  "StrictRefEq :: [('𝔄,::null)Sequence,('𝔄,::null)Sequence]  ('𝔄)Boolean"
begin
  definition StrictRefEqSeq :
    "((x::('𝔄,::null)Sequence)  y)  (λ τ. if (υ x) τ = true τ  (υ y) τ = true τ
                                                then (x  y)τ
                                                else invalid τ)"
end

text_raw‹\isatagafp›
text‹One might object here that for the case of objects, this is an empty definition.
The answer is no, we will restrain later on states and objects such that any object
has its oid stored inside the object (so the ref, under which an object can be referenced
in the store will represented in the object itself). For such well-formed stores that satisfy
this invariant (the WFF-invariant), the referential equality and the
strong equality---and therefore the strict equality on sequences in the sense above---coincides.›
text_raw‹\endisatagafp›

text‹Property proof in terms of @{term "profile_binStrongEq_v_v"}
interpretation  StrictRefEqSeq : profile_binStrongEq_v_v "λ x y. (x::('𝔄,::null)Sequence)  y" 
                by unfold_locales (auto simp:  StrictRefEqSeq)



subsection‹Constants: mtSequence›
definition mtSequence ::"('𝔄,::null) Sequence"  ("Sequence{}")
where     "Sequence{}  (λ τ.  Abs_Sequencebase []:: list )"


lemma mtSequence_defined[simp,code_unfold]:"δ(Sequence{}) = true"
apply(rule ext, auto simp: mtSequence_def defined_def null_Sequencebase_def
                           bot_Sequencebase_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Sequencebase_inject bot_option_def null_option_def)

lemma mtSequence_valid[simp,code_unfold]:"υ(Sequence{}) = true"
apply(rule ext,auto simp: mtSequence_def valid_def null_Sequencebase_def
                          bot_Sequencebase_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Sequencebase_inject bot_option_def null_option_def)

lemma mtSequence_rep_set: "Rep_Sequencebase (Sequence{} τ) = []"
 apply(simp add: mtSequence_def, subst Abs_Sequencebase_inverse)
by(simp add: bot_option_def)+

text_raw‹\isatagafp›

lemma [simp,code_unfold]: "const Sequence{}"
by(simp add: const_def mtSequence_def)

text‹Note that the collection types in OCL allow for null to be included;
  however, there is the null-collection into which inclusion yields invalid.›

text_raw‹\endisatagafp›


subsection‹Definition: Prepend›
definition OclPrepend   :: "[('𝔄,::null) Sequence,('𝔄,) val]  ('𝔄,) Sequence"
where     "OclPrepend x y = (λ τ. if (δ x) τ = true τ  (υ y) τ = true τ
                                    then Abs_Sequencebase  (y τ)#Rep_Sequencebase (x τ) 
                                    else invalid τ )"
notation   OclPrepend   ("_->prependSeq'(_')")

interpretation OclPrepend:profile_bind_v OclPrepend "λx y. Abs_Sequencebasey#Rep_Sequencebase x"
proof -  
 have A : "x y. x  bot  x  null   y  bot  
           y#Rep_Sequencebase x  {X. X = bot  X = null  (xset X. x  bot)}"
          by(auto intro!:Sequence_inv_lemma[simplified OclValid_def 
                         defined_def false_def true_def null_fun_def bot_fun_def])  
                                       
         show "profile_bind_v OclPrepend (λx y. Abs_Sequencebase y#Rep_Sequencebase x)"
         apply unfold_locales  
          apply(auto simp:OclPrepend_def bot_option_def null_option_def null_Sequencebase_def 
               bot_Sequencebase_def)
          apply(erule_tac Q="Abs_Sequencebase y#Rep_Sequencebase x = Abs_Sequencebase None" 
                in contrapos_pp)
          apply(subst Abs_Sequencebase_inject [OF A])
             apply(simp_all add:  null_Sequencebase_def bot_Sequencebase_def bot_option_def)
         apply(erule_tac Q="Abs_Sequencebasey#Rep_Sequencebase x = Abs_Sequencebase None" 
               in contrapos_pp)
         apply(subst Abs_Sequencebase_inject[OF A])
            apply(simp_all add:  null_Sequencebase_def bot_Sequencebase_def 
                                 bot_option_def null_option_def)
         done
qed
                
syntax
  "_OclFinsequence" :: "args => ('𝔄,'a::null) Sequence"    ("Sequence{(_)}")
translations
  "Sequence{x, xs}" == "CONST OclPrepend (Sequence{xs}) x"
  "Sequence{x}"     == "CONST OclPrepend (Sequence{}) x "

subsection‹Definition: Including›

definition OclIncluding   :: "[('𝔄,::null) Sequence,('𝔄,) val]  ('𝔄,) Sequence"
where     "OclIncluding x y = (λ τ. if (δ x) τ = true τ  (υ y) τ = true τ
                                    then Abs_Sequencebase  Rep_Sequencebase (x τ)  @ [y τ] 
                                    else invalid τ )"
notation   OclIncluding   ("_->includingSeq'(_')")

interpretation OclIncluding : 
               profile_bind_v OclIncluding "λx y. Abs_SequencebaseRep_Sequencebase x @ [y]"
proof -  
 have A : "x y. x  bot  x  null   y  bot  
           Rep_Sequencebase x @ [y]  {X. X = bot  X = null  (xset X. x  bot)}"
          by(auto intro!:Sequence_inv_lemma[simplified OclValid_def 
                         defined_def false_def true_def null_fun_def bot_fun_def])  
                                       
         show "profile_bind_v OclIncluding (λx y. Abs_Sequencebase Rep_Sequencebase x @ [y])"
         apply unfold_locales  
          apply(auto simp:OclIncluding_def bot_option_def null_option_def null_Sequencebase_def 
               bot_Sequencebase_def)
          apply(erule_tac Q="Abs_Sequencebase Rep_Sequencebase x @ [y] = Abs_Sequencebase None" 
                in contrapos_pp)
          apply(subst Abs_Sequencebase_inject [OF A])
             apply(simp_all add:  null_Sequencebase_def bot_Sequencebase_def bot_option_def)
         apply(erule_tac Q="Abs_SequencebaseRep_Sequencebase x @ [y] = Abs_Sequencebase None" 
               in contrapos_pp)
         apply(subst Abs_Sequencebase_inject[OF A])
            apply(simp_all add:  null_Sequencebase_def bot_Sequencebase_def bot_option_def null_option_def)
         done
qed

lemma [simp,code_unfold] : "(Sequence{}->includingSeq(a)) = (Sequence{}->prependSeq(a))"
  apply(simp add: OclIncluding_def OclPrepend_def mtSequence_def)
  apply(subst (1 2) Abs_Sequencebase_inverse, simp)
by(metis drop.simps append_Nil)

lemma [simp,code_unfold] : "((S->prependSeq(a))->includingSeq(b)) = ((S->includingSeq(b))->prependSeq(a))"
 proof -
  have A: "S b τ. S    S  null  b    
                   Rep_Sequencebase S @ [b]  {X. X = bot  X = null  (xset X. x  )}"
           by(auto intro!:Sequence_inv_lemma[simplified OclValid_def 
                                        defined_def false_def true_def null_fun_def bot_fun_def])          
  have B: "S a τ. S    S  null  a    
                   a # Rep_Sequencebase S  {X. X = bot  X = null  (xset X. x  )}"
           by(auto intro!:Sequence_inv_lemma[simplified OclValid_def 
                                        defined_def false_def true_def null_fun_def bot_fun_def])          
 show ?thesis
  apply(simp add: OclIncluding_def OclPrepend_def mtSequence_def, rule ext)
  apply(subst (2 5) cp_defined, simp split:)
  apply(intro conjI impI)
        apply(subst Abs_Sequencebase_inverse[OF B],
              (simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+)
        apply(subst Abs_Sequencebase_inverse[OF A],
              (simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+)
       apply(simp add: OclIncluding.def_body)
      apply (metis OclValid_def foundation16 invalid_def)
     apply (metis (no_types) OclPrepend.def_body' OclValid_def foundation16)
 by (metis OclValid_def foundation16 invalid_def)+
qed

subsection‹Definition: Excluding›
definition OclExcluding   :: "[('𝔄,::null) Sequence,('𝔄,) val]  ('𝔄,) Sequence"
where     "OclExcluding x y = (λ τ. if (δ x) τ = true τ  (υ y) τ = true τ
                                    then Abs_Sequencebase  filter (λx. x = y τ)
                                                                   Rep_Sequencebase (x τ)
                                    else invalid τ )"
notation   OclExcluding   ("_->excludingSeq'(_')")

interpretation OclExcluding:profile_bind_v OclExcluding 
                          "λx y. Abs_Sequencebase  filter (λx. x = y) Rep_Sequencebase (x)"
proof -
    show "profile_bind_v OclExcluding (λx y. Abs_Sequencebase [xRep_Sequencebase x . x = y])"
         apply unfold_locales  
         apply(auto simp:OclExcluding_def bot_option_def null_option_def  
                         null_Sequencebase_def bot_Sequencebase_def)
         apply(subst (asm) Abs_Sequencebase_inject,
               simp_all add: null_Sequencebase_def bot_Sequencebase_def bot_option_def null_option_def)+
   done
qed

subsection‹Definition: Append›
text‹Identical to OclIncluding.›
definition OclAppend   :: "[('𝔄,::null) Sequence,('𝔄,) val]  ('𝔄,) Sequence"
where     "OclAppend = OclIncluding"
notation   OclAppend   ("_->appendSeq'(_')")

interpretation OclAppend : 
               profile_bind_v OclAppend "λx y. Abs_SequencebaseRep_Sequencebase x @ [y]"
         apply unfold_locales
 by(auto simp: OclAppend_def bin_def bin'_def
               OclIncluding.def_scheme OclIncluding.def_body)

subsection‹Definition: Union›
definition OclUnion   :: "[('𝔄,::null) Sequence,('𝔄,) Sequence]  ('𝔄,) Sequence"
where     "OclUnion x y = (λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                                then Abs_Sequencebase  Rep_Sequencebase (x τ) @
                                                        Rep_Sequencebase (y τ)
                                else invalid τ )"
notation   OclUnion   ("_->unionSeq'(_')")

interpretation OclUnion : 
               profile_bind_d OclUnion "λx y. Abs_SequencebaseRep_Sequencebase x @ Rep_Sequencebase y"
proof -  
   have A : "x y. x     x  null  xset Rep_Sequencebase x. x   " 
            apply(rule Sequence_inv_lemma[of τ])
            by(simp add: defined_def OclValid_def bot_fun_def null_fun_def false_def true_def)   
   show "profile_bind_d OclUnion (λx y. Abs_SequencebaseRep_Sequencebase x@Rep_Sequencebase y)"
   apply unfold_locales 
   apply(auto simp:OclUnion_def bot_option_def null_option_def 
                   null_Sequencebase_def bot_Sequencebase_def)
   by(subst (asm) Abs_Sequencebase_inject,
      simp_all add: bot_option_def null_option_def  Set.ball_Un A null_Sequencebase_def bot_Sequencebase_def)+
qed

subsection‹Definition: At›
definition OclAt   :: "[('𝔄,::null) Sequence,('𝔄) Integer]  ('𝔄,) val"
where     "OclAt x y = (λ τ. if (δ x) τ = true τ  (δ y) τ = true τ
                             then if  1  y τ   y τ  lengthRep_Sequencebase (x τ) 
                                  then Rep_Sequencebase (x τ) ! (nat y τ - 1) 
                                  else invalid τ
                             else invalid τ )"
notation   OclAt ("_->atSeq'(_')")
(*TODO Locale - Equivalent*)  


subsection‹Definition: First›
definition OclFirst   :: "[('𝔄,::null) Sequence]  ('𝔄,) val"
where     "OclFirst x = (λ τ. if (δ x) τ = true τ then
                                case Rep_Sequencebase (x τ) of []  invalid τ
                                                               | x # _  x
                              else invalid τ )"
notation   OclFirst   ("_->firstSeq'(_')")
(*TODO Locale - Equivalent*)  


subsection‹Definition: Last›
definition OclLast   :: "[('𝔄,::null) Sequence]  ('𝔄,) val"
where     "OclLast x = (λ τ. if (δ x) τ = true τ then
                               if Rep_Sequencebase (x τ) = [] then
                                 invalid τ
                               else
                                 last Rep_Sequencebase (x τ)
                             else invalid τ )"
notation   OclLast   ("_->lastSeq'(_')")
(*TODO Locale - Equivalent*)  

subsection‹Definition: Iterate›

definition OclIterate :: "[('𝔄,::null) Sequence,('𝔄,::null)val,
                           ('𝔄,)val('𝔄,)val('𝔄,)val]  ('𝔄,)val"
where     "OclIterate S A F = (λ τ. if (δ S) τ = true τ  (υ A) τ = true τ 
                                    then (foldr (F) (map (λa τ. a) Rep_Sequencebase (S τ)))(A)τ
                                    else )"
syntax  
  "_OclIterateSeq"  :: "[('𝔄,::null) Sequence, idt, idt, , ] => ('𝔄,)val"
                        ("_ ->iterateSeq'(_;_=_ | _')" (*[71,100,70]50*))
translations
  "X->iterateSeq(a; x = A | P)" == "CONST OclIterate X A (%a. (% x. P))"

(*TODO Locale - Equivalent*)  

  
  
subsection‹Definition: Forall›
definition OclForall     :: "[('𝔄,::null) Sequence,('𝔄,)val('𝔄)Boolean]  '𝔄 Boolean"
where     "OclForall S P = (S->iterateSeq(b; x = true | x and (P b)))"

syntax
  "_OclForallSeq" :: "[('𝔄,::null) Sequence,id,('𝔄)Boolean]  '𝔄 Boolean"    ("(_)->forAllSeq'(_|_')")
translations
  "X->forAllSeq(x | P)" == "CONST UML_Sequence.OclForall X (%x. P)"

(*TODO Locale - Equivalent*)  

subsection‹Definition: Exists›
definition OclExists     :: "[('𝔄,::null) Sequence,('𝔄,)val('𝔄)Boolean]  '𝔄 Boolean"
where     "OclExists S P = (S->iterateSeq(b; x = false | x or (P b)))"

syntax
  "_OclExistSeq" :: "[('𝔄,::null) Sequence,id,('𝔄)Boolean]  '𝔄 Boolean"    ("(_)->existsSeq'(_|_')")
translations
  "X->existsSeq(x | P)" == "CONST OclExists X (%x. P)"

(*TODO Locale - Equivalent*)  

subsection‹Definition: Collect›
definition OclCollect     :: "[('𝔄,::null)Sequence,('𝔄,)val('𝔄,)val]('𝔄,::null)Sequence"
where     "OclCollect S P = (S->iterateSeq(b; x = Sequence{} | x->prependSeq(P b)))"

syntax
  "_OclCollectSeq" :: "[('𝔄,::null) Sequence,id,('𝔄)Boolean]  '𝔄 Boolean"    ("(_)->collectSeq'(_|_')")
translations
  "X->collectSeq(x | P)" == "CONST OclCollect X (%x. P)"

(*TODO Locale - Equivalent*)  

subsection‹Definition: Select›
definition OclSelect     :: "[('𝔄,::null)Sequence,('𝔄,)val('𝔄)Boolean]('𝔄,::null)Sequence"
where     "OclSelect S P = 
           (S->iterateSeq(b; x = Sequence{} | if P b then x->prependSeq(b) else x endif))"

syntax
  "_OclSelectSeq" :: "[('𝔄,::null) Sequence,id,('𝔄)Boolean]  '𝔄 Boolean"  ("(_)->selectSeq'(_|_')")
translations
  "X->selectSeq(x | P)" == "CONST UML_Sequence.OclSelect X (%x. P)"

(*TODO Locale - Equivalent*)  

subsection‹Definition: Size›
definition OclSize     :: "[('𝔄,::null)Sequence]('𝔄)Integer" ("(_)->sizeSeq'(')")
where     "OclSize S = (S->iterateSeq(b; x = 𝟬 | x +int 𝟭 ))"

(*TODO Locale - Equivalent*)  

subsection‹Definition: IsEmpty›
definition OclIsEmpty   :: "('𝔄,::null) Sequence  '𝔄 Boolean"
where     "OclIsEmpty x =  ((υ x and not (δ x)) or ((OclSize x)  𝟬))"
notation   OclIsEmpty     ("_->isEmptySeq'(')" (*[66]*))

(*TODO Locale - Equivalent*)  

subsection‹Definition: NotEmpty›

definition OclNotEmpty   :: "('𝔄,::null) Sequence  '𝔄 Boolean"
where     "OclNotEmpty x =  not(OclIsEmpty x)"
notation   OclNotEmpty    ("_->notEmptySeq'(')" (*[66]*))

(*TODO Locale - Equivalent*)  

subsection‹Definition: Any›

definition "OclANY x = (λ τ.
  if x τ = invalid τ then
    
  else
    case drop (drop (Rep_Sequencebase (x τ))) of []  
                                              | l  hd l)"
notation   OclANY   ("_->anySeq'(')")

(*TODO Locale - Equivalent*)  

subsection‹Definition (future operators)›

consts (* abstract set collection operations *)
    OclCount       :: "[('𝔄,::null) Sequence,('𝔄,) Sequence]  '𝔄 Integer"
  (*OclFlatten*)
  (*OclInsertAt*)
  (*OclSubSequence*)
  (*OclIndexOf*)
  (*OclReverse*)
    OclSum         :: " ('𝔄,::null) Sequence  '𝔄 Integer"
  
notation  OclCount       ("_->countSeq'(_')" (*[66,65]65*))
notation  OclSum         ("_->sumSeq'(')" (*[66]*))

subsection‹Logical Properties›

subsection‹Execution Laws with Invalid or Null as Argument›

text‹OclIterate›

lemma OclIterate_invalid[simp,code_unfold]:"invalid->iterateSeq(a; x = A | P a x) = invalid"  
by(simp add: OclIterate_def false_def true_def, simp add: invalid_def)

lemma OclIterate_null[simp,code_unfold]:"null->iterateSeq(a; x = A | P a x) = invalid"  
by(simp add: OclIterate_def false_def true_def, simp add: invalid_def)

lemma OclIterate_invalid_args[simp,code_unfold]:"S->iterateSeq(a; x = invalid | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)

text_raw‹\isatagafp›

subsubsection‹Context Passing›

lemma cp_OclIncluding:
"(X->includingSeq(x)) τ = ((λ _. X τ)->includingSeq(λ _. x τ)) τ"
by(auto simp: OclIncluding_def StrongEq_def invalid_def
                 cp_defined[symmetric] cp_valid[symmetric])

lemma cp_OclIterate: 
     "(X->iterateSeq(a; x = A | P a x)) τ =
                ((λ _. X τ)->iterateSeq(a; x = A | P a x)) τ"
by(simp add: OclIterate_def cp_defined[symmetric])

lemmas cp_intro''Seq[intro!,simp,code_unfold] = 
       cp_OclIncluding [THEN allI[THEN allI[THEN allI[THEN cpI2]], of "OclIncluding"]]

subsubsection‹Const›

text_raw‹\endisatagafp›

subsection‹General Algebraic Execution Rules›
subsubsection‹Execution Rules on Iterate›

lemma OclIterate_empty[simp,code_unfold]:"Sequence{}->iterateSeq(a; x = A | P a x) = A"  
apply(simp add: OclIterate_def foundation22[symmetric] foundation13, 
      rule ext, rename_tac "τ")
apply(case_tac "τ  υ A", simp_all add: foundation18')
apply(simp add: mtSequence_def)
apply(subst Abs_Sequencebase_inverse) by auto

text‹In particular, this does hold for A = null.›

lemma OclIterate_including[simp,code_unfold]:
assumes strict1 : "X. P invalid X = invalid"
and     P_valid_arg: " τ. (υ A) τ = (υ (P a A)) τ"
and     P_cp    : " x y τ. P x y τ = P (λ _. x τ) y τ"
and     P_cp'   : " x y τ. P x y τ = P x (λ _. y τ) τ"
shows  "(S->includingSeq(a))->iterateSeq(b; x = A | P b x) = S->iterateSeq(b; x = P a A| P b x)"
 apply(rule ext)
proof -
 have A: "S b τ. S    S  null  b    
                  Rep_Sequencebase S @ [b]  {X. X = bot  X = null  (xset X. x  )}"
          by(auto intro!:Sequence_inv_lemma[simplified OclValid_def 
                                       defined_def false_def true_def null_fun_def bot_fun_def])          
 have P: "l A A' τ. A τ = A' τ  foldr P l A τ = foldr P l A' τ"
  apply(rule list.induct, simp, simp)
 by(subst (1 2) P_cp', simp)

 fix τ
 show "OclIterate (S->includingSeq(a)) A P τ = OclIterate S (P a A) P τ"
  apply(subst cp_OclIterate, subst OclIncluding_def, simp split:)
  apply(intro conjI impI)

   apply(simp add: OclIterate_def)
   apply(intro conjI impI)
     apply(subst Abs_Sequencebase_inverse[OF A],
           (simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+)
     apply(rule P, metis P_cp)
    apply (metis P_valid_arg)
   apply(simp add: P_valid_arg[symmetric])
   apply (metis (lifting, no_types) OclIncluding.def_body' OclValid_def foundation16)
  apply(simp add: OclIterate_def defined_def invalid_def bot_option_def bot_fun_def false_def true_def)
  apply(intro impI, simp add: false_def true_def P_valid_arg)
 by (metis P_cp P_valid_arg UML_Types.bot_fun_def cp_valid invalid_def strict1 true_def valid1 valid_def)
qed

lemma OclIterate_prepend[simp,code_unfold]:
assumes strict1 : "X. P invalid X = invalid"
and     strict2 : "X. P X invalid = invalid"
and     P_cp    : " x y τ. P x y τ = P (λ _. x τ) y τ"
and     P_cp'   : " x y τ. P x y τ = P x (λ _. y τ) τ"
shows  "(S->prependSeq(a))->iterateSeq(b; x = A | P b x) = P a (S->iterateSeq(b; x = A| P b x))"
 apply(rule ext)
proof -
 have B: "S a τ. S    S  null  a    
                  a # Rep_Sequencebase S  {X. X = bot  X = null  (xset X. x  )}"
          by(auto intro!:Sequence_inv_lemma[simplified OclValid_def 
                                       defined_def false_def true_def null_fun_def bot_fun_def])          
 fix τ
 show "OclIterate (S->prependSeq(a)) A P τ = P a (OclIterate S A P) τ"
  apply(subst cp_OclIterate, subst OclPrepend_def, simp split:)
  apply(intro conjI impI)

   apply(subst P_cp')
   apply(simp add: OclIterate_def)
   apply(intro conjI impI)
     apply(subst Abs_Sequencebase_inverse[OF B],
           (simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+)
     apply(simp add: P_cp'[symmetric])
     apply(subst P_cp, simp add: P_cp[symmetric])
    apply (metis (no_types) OclPrepend.def_body' OclValid_def foundation16)
   apply (metis P_cp' invalid_def strict2 valid_def)

  apply(subst P_cp',
        simp add: OclIterate_def defined_def invalid_def bot_option_def bot_fun_def false_def true_def,
        intro conjI impI)
     apply (metis P_cp' invalid_def strict2 valid_def)
    apply (metis P_cp' invalid_def strict2 valid_def)
   apply (metis (no_types) P_cp invalid_def strict1 true_def valid1 valid_def)
  apply (metis P_cp' invalid_def strict2 valid_def)
 done
qed


(* < *)

subsection‹Test Statements›
(*
Assert   "(τ ⊨ (Sequence{λ_. ⌊⌊x⌋⌋} ≐ Sequence{λ_. ⌊⌊x⌋⌋}))"
Assert   "(τ ⊨ (Sequence{λ_. ⌊x⌋} ≐ Sequence{λ_. ⌊x⌋}))"
*)

instantiation Sequencebase  :: (equal)equal
begin
  definition "HOL.equal k l   (k::('a::equal)Sequencebase) =  l"
  instance   by standard (rule equal_Sequencebase_def)
end

lemma equal_Sequencebase_code [code]:
  "HOL.equal k (l::('a::{equal,null})Sequencebase)  Rep_Sequencebase k = Rep_Sequencebase l"
  by (auto simp add: equal Sequencebase.Rep_Sequencebase_inject)
  
Assert   "τ  (Sequence{}  Sequence{})" 
Assert   "τ  (Sequence{𝟭,𝟮}  Sequence{}->prependSeq(𝟮)->prependSeq(𝟭))" 
Assert   "τ  (Sequence{𝟭,invalid,𝟮}  invalid)"
Assert   "τ  (Sequence{𝟭,𝟮}->prependSeq(null)  Sequence{null,𝟭,𝟮})"
Assert   "τ  (Sequence{𝟭,𝟮}->includingSeq(null)  Sequence{𝟭,𝟮,null})"

(* 
Assert   "¬ (τ ⊨ (Sequence{𝟭,𝟭,𝟮} ≐ Sequence{𝟭,𝟮}))"
Assert   "¬ (τ ⊨ (Sequence{𝟭,𝟮} ≐ Sequence{𝟮,𝟭}))"
*)

(* > *)

end

Theory UML_Library

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Library.thy --- Library definitions.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)


theory  UML_Library
imports (* Basic Type Operations *)
        "basic_types/UML_Boolean"
        "basic_types/UML_Void"
        "basic_types/UML_Integer"
        "basic_types/UML_Real"
        "basic_types/UML_String"
        
        (* Collection Type Operations *)
        "collection_types/UML_Pair"
        "collection_types/UML_Bag"
        "collection_types/UML_Set"
        "collection_types/UML_Sequence"
begin

section‹Miscellaneous Stuff›

subsection‹Definition: asBoolean›

definition OclAsBooleanInt  :: "('𝔄) Integer  ('𝔄) Boolean" ("(_)->oclAsTypeInt'(Boolean')")
where     "OclAsBooleanInt X = (λτ. if (δ X) τ = true τ 
                              then X τ  0
                              else invalid τ)"

interpretation OclAsBooleanInt : profile_monod OclAsBooleanInt "λx. x  0"
                                by unfold_locales (auto simp: OclAsBooleanInt_def bot_option_def)

definition OclAsBooleanReal  :: "('𝔄) Real  ('𝔄) Boolean" ("(_)->oclAsTypeReal'(Boolean')")
where     "OclAsBooleanReal X = (λτ. if (δ X) τ = true τ 
                              then X τ  0
                              else invalid τ)"

interpretation OclAsBooleanReal : profile_monod OclAsBooleanReal "λx. x  0"
                                 by unfold_locales (auto simp: OclAsBooleanReal_def bot_option_def)

subsection‹Definition: asInteger›

definition OclAsIntegerReal  :: "('𝔄) Real  ('𝔄) Integer" ("(_)->oclAsTypeReal'(Integer')")
where     "OclAsIntegerReal X = (λτ. if (δ X) τ = true τ 
                              then floor X τ
                              else invalid τ)"

interpretation OclAsIntegerReal : profile_monod OclAsIntegerReal "λx. floor x"
                                 by unfold_locales (auto simp: OclAsIntegerReal_def bot_option_def)

subsection‹Definition: asReal›

definition OclAsRealInt  :: "('𝔄) Integer  ('𝔄) Real" ("(_)->oclAsTypeInt'(Real')")
where     "OclAsRealInt X = (λτ. if (δ X) τ = true τ 
                              then real_of_int X τ
                              else invalid τ)"

interpretation OclAsRealInt : profile_monod OclAsRealInt "λx. real_of_int x"
                             by unfold_locales (auto simp: OclAsRealInt_def bot_option_def)

lemma Integer_subtype_of_Real: 
  assumes "τ  δ X"
  shows   "τ  X ->oclAsTypeInt(Real) ->oclAsTypeReal(Integer)  X"
  apply(insert assms,  simp add: OclAsIntegerReal_def OclAsRealInt_def OclValid_def StrongEq_def)
  apply(subst (2 4) cp_defined, simp add: true_def)
  by (metis assms bot_option_def drop.elims foundation16 null_option_def)

subsection‹Definition: asPair›

definition OclAsPairSeq   :: "[('𝔄,::null)Sequence]('𝔄,::null,::null) Pair" ("(_)->asPairSeq'(')")
where     "OclAsPairSeq S = (if S->sizeSeq()  𝟮
                            then Pair{S->atSeq(𝟬),S->atSeq(𝟭)}
                            else invalid
                            endif)"

definition OclAsPairSet   :: "[('𝔄,::null)Set]('𝔄,::null,::null) Pair" ("(_)->asPairSet'(')")
where     "OclAsPairSet S = (if S->sizeSet()  𝟮
                            then let v = S->anySet() in
                                 Pair{v,S->excludingSet(v)->anySet()}
                            else invalid
                            endif)"

definition OclAsPairBag   :: "[('𝔄,::null)Bag]('𝔄,::null,::null) Pair" ("(_)->asPairBag'(')")
where     "OclAsPairBag S = (if S->sizeBag()  𝟮
                            then let v = S->anyBag() in
                                 Pair{v,S->excludingBag(v)->anyBag()}
                            else invalid
                            endif)"

subsection‹Definition: asSet›

definition OclAsSetSeq   :: "[('𝔄,::null)Sequence]('𝔄,)Set" ("(_)->asSetSeq'(')")
where     "OclAsSetSeq S = (S->iterateSeq(b; x = Set{} | x ->includingSet(b)))"

definition OclAsSetPair   :: "[('𝔄,::null,::null) Pair]('𝔄,)Set" ("(_)->asSetPair'(')")
where     "OclAsSetPair S = Set{S .First(), S .Second()}"

definition OclAsSetBag   :: "('𝔄,::null) Bag('𝔄,)Set" ("(_)->asSetBag'(')")
where     "OclAsSetBag S =  (λ τ. if (δ S) τ = true τ 
                                 then Abs_Setbase Rep_Set_base S τ  
                                 else if (υ S) τ = true τ then null τ 
                                                          else invalid τ)"

subsection‹Definition: asSequence›

definition OclAsSeqSet   :: "[('𝔄,::null)Set]('𝔄,)Sequence" ("(_)->asSequenceSet'(')")
where     "OclAsSeqSet S = (S->iterateSet(b; x = Sequence{} | x ->includingSeq(b)))"

definition OclAsSeqBag   :: "[('𝔄,::null)Bag]('𝔄,)Sequence" ("(_)->asSequenceBag'(')")
where     "OclAsSeqBag S = (S->iterateBag(b; x = Sequence{} | x ->includingSeq(b)))"

definition OclAsSeqPair   :: "[('𝔄,::null,::null) Pair]('𝔄,)Sequence" ("(_)->asSequencePair'(')")
where     "OclAsSeqPair S = Sequence{S .First(), S .Second()}"

subsection‹Definition: asBag›

definition OclAsBagSeq   :: "[('𝔄,::null)Sequence]('𝔄,)Bag" ("(_)->asBagSeq'(')")
where     "OclAsBagSeq S = (λτ. Abs_Bagbase λs. if list_ex ((=) s) Rep_Sequencebase (S τ) then 1 else 0)"

definition OclAsBagSet   :: "[('𝔄,::null)Set]('𝔄,)Bag" ("(_)->asBagSet'(')")
where     "OclAsBagSet S = (λτ. Abs_Bagbase λs. if s  Rep_Setbase (S τ) then 1 else 0)"

lemma assumes "τ  δ (S ->sizeSet())" (* S is finite *)
      shows "OclAsBagSet S = (S->iterateSet(b; x = Bag{} | x ->includingBag(b)))"
oops

definition OclAsBagPair   :: "[('𝔄,::null,::null) Pair]('𝔄,)Bag" ("(_)->asBagPair'(')")
where     "OclAsBagPair S = Bag{S .First(), S .Second()}"

text_raw‹\isatagafp›
subsection‹Collection Types›
lemmas cp_intro'' [intro!,simp,code_unfold] =
       cp_intro'
     (*  cp_intro''Pair *)
       cp_intro''Set
       cp_intro''Seq
text_raw‹\endisatagafp›

subsection‹Test Statements›

lemma syntax_test: "Set{𝟮,𝟭} = (Set{}->includingSet(𝟭)->includingSet(𝟮))"
by (rule refl)

text‹Here is an example of a nested collection.›
lemma semantic_test2:
assumes H:"(Set{𝟮}  null) = (false::('𝔄)Boolean)"
shows   "(τ::('𝔄)st)  (Set{Set{𝟮},null}->includesSet(null))"
by(simp add: OclIncludes_executeSet H)



lemma short_cut'[simp,code_unfold]: "(𝟴  𝟲) = false"
 apply(rule ext)
 apply(simp add: StrictRefEqInteger StrongEq_def OclInt8_def OclInt6_def
                 true_def false_def invalid_def bot_option_def)
done

lemma short_cut''[simp,code_unfold]: "(𝟮  𝟭) = false"
 apply(rule ext)
 apply(simp add: StrictRefEqInteger StrongEq_def OclInt2_def OclInt1_def
                 true_def false_def invalid_def bot_option_def)
done
lemma short_cut'''[simp,code_unfold]: "(𝟭  𝟮) = false"
 apply(rule ext)
 apply(simp add: StrictRefEqInteger StrongEq_def OclInt2_def OclInt1_def
                 true_def false_def invalid_def bot_option_def)
done

Assert   "τ  (𝟬 <int 𝟮) and (𝟬 <int 𝟭) "


text‹Elementary computations on Sets.›

declare OclSelect_body_def [simp]

Assert "¬ (τ  υ(invalid::('𝔄,::null) Set))"
Assert    "τ  υ(null::('𝔄,::null) Set)"
Assert "¬ (τ  δ(null::('𝔄,::null) Set))"
Assert    "τ  υ(Set{})"
Assert    "τ  υ(Set{Set{𝟮},null})"
Assert    "τ  δ(Set{Set{𝟮},null})"
Assert    "τ  (Set{𝟮,𝟭}->includesSet(𝟭))"
Assert "¬ (τ  (Set{𝟮}->includesSet(𝟭)))"
Assert "¬ (τ  (Set{𝟮,𝟭}->includesSet(null)))"
Assert    "τ  (Set{𝟮,null}->includesSet(null))"
Assert    "τ  (Set{null,𝟮}->includesSet(null))"

Assert    "τ  ((Set{})->forAllSet(z | 𝟬 <int z))"

Assert    "τ  ((Set{𝟮,𝟭})->forAllSet(z | 𝟬 <int z))"
Assert "¬ (τ  ((Set{𝟮,𝟭})->existsSet(z | z <int 𝟬 )))"
Assert "¬ (τ  (δ(Set{𝟮,null})->forAllSet(z | 𝟬 <int z)))"
Assert "¬ (τ  ((Set{𝟮,null})->forAllSet(z | 𝟬 <int z)))"
Assert    "τ  ((Set{𝟮,null})->existsSet(z | 𝟬 <int z))"


Assert "¬ (τ  (Set{null::'a Boolean}  Set{}))"
Assert "¬ (τ  (Set{null::'a Integer}  Set{}))"

Assert "¬ (τ  (Set{true}  Set{false}))"
Assert "¬ (τ  (Set{true,true}  Set{false}))"
Assert "¬ (τ  (Set{𝟮}  Set{𝟭}))"
Assert    "τ  (Set{𝟮,null,𝟮}  Set{null,𝟮})"
Assert    "τ  (Set{𝟭,null,𝟮} <> Set{null,𝟮})"
Assert    "τ  (Set{Set{𝟮,null}}  Set{Set{null,𝟮}})"
Assert    "τ  (Set{Set{𝟮,null}} <> Set{Set{null,𝟮},null})"
Assert    "τ  (Set{null}->selectSet(x | not x)  Set{null})"
Assert    "τ  (Set{null}->rejectSet(x | not x)  Set{null})"

lemma     "const (Set{Set{𝟮,null}, invalid})" by(simp add: const_ss)


text‹Elementary computations on Sequences.›

Assert "¬ (τ  υ(invalid::('𝔄,::null) Sequence))"
Assert    "τ  υ(null::('𝔄,::null) Sequence)"
Assert "¬ (τ  δ(null::('𝔄,::null) Sequence))"
Assert    "τ  υ(Sequence{})"

lemma     "const (Sequence{Sequence{𝟮,null}, invalid})" by(simp add: const_ss)

end

Theory UML_State

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_State.thy --- State Operations and Objects.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

chapter‹Formalization III:  UML/OCL constructs: State Operations and Objects›

theory  UML_State
imports UML_Library
begin

no_notation None ("")
section‹Introduction: States over Typed Object Universes›

text‹\label{sec:universe}
  In the following, we will refine the concepts of a user-defined
  data-model (implied by a class-diagram) as well as the notion of
  $\state{}$ used in the previous section to much more detail.
  Surprisingly, even without a concrete notion of an objects and a
  universe of object representation, the generic infrastructure of
  state-related operations is fairly rich.
›



subsection‹Fundamental Properties on Objects: Core Referential Equality›
subsubsection‹Definition›

text‹Generic referential equality - to be used for instantiations
 with concrete object types ...›
definition  StrictRefEqObject :: "('𝔄,'a::{object,null})val  ('𝔄,'a)val  ('𝔄)Boolean"
where      "StrictRefEqObject x y
             λ τ. if (υ x) τ = true τ  (υ y) τ = true τ
                    then if x τ = null  y τ = null
                         then x τ = null  y τ = null
                         else (oid_of (x τ)) = (oid_of (y τ)) 
                    else invalid τ"

subsubsection‹Strictness and context passing›

lemma StrictRefEqObject_strict1[simp,code_unfold] :
"(StrictRefEqObject x invalid) = invalid"
by(rule ext, simp add: StrictRefEqObject_def true_def false_def)

lemma StrictRefEqObject_strict2[simp,code_unfold] :
"(StrictRefEqObject invalid x) = invalid"
by(rule ext, simp add: StrictRefEqObject_def true_def false_def)


lemma cp_StrictRefEqObject:
"(StrictRefEqObject x y τ) = (StrictRefEqObject (λ_. x τ) (λ_. y τ)) τ"
by(auto simp: StrictRefEqObject_def cp_valid[symmetric])

text_raw‹\isatagafp›
lemmas cp0_StrictRefEqObject= cp_StrictRefEqObject[THEN allI[THEN allI[THEN allI[THEN cpI2]],
             of "StrictRefEqObject"]]

lemmas cp_intro''[intro!,simp,code_unfold] =
       cp_intro''
       cp_StrictRefEqObject[THEN allI[THEN allI[THEN allI[THEN cpI2]],
             of "StrictRefEqObject"]]

text_raw‹\endisatagafp›

subsection‹Logic and Algebraic Layer on Object›
subsubsection‹Validity and Definedness Properties›

text‹We derive the usual laws on definedness for (generic) object equality:›
lemma StrictRefEqObject_defargs:
"τ  (StrictRefEqObject x (y::('𝔄,'a::{null,object})val)) (τ (υ x))  (τ (υ y))"
by(simp add: StrictRefEqObject_def OclValid_def true_def invalid_def bot_option_def
        split: bool.split_asm HOL.if_split_asm)

lemma defined_StrictRefEqObject_I:
 assumes val_x : "τ  υ x"
 assumes val_x : "τ  υ y"
 shows "τ  δ (StrictRefEqObject x y)"
 apply(insert assms, simp add: StrictRefEqObject_def OclValid_def)
by(subst cp_defined, simp add: true_def)

lemma StrictRefEqObject_def_homo :
"δ(StrictRefEqObject x (y::('𝔄,'a::{null,object})val)) = ((υ x) and (υ y))"
oops (* sorry *)

subsubsection‹Symmetry›

lemma StrictRefEqObject_sym :
assumes x_val : "τ  υ x"
shows "τ  StrictRefEqObject x x"
by(simp add: StrictRefEqObject_def true_def OclValid_def
             x_val[simplified OclValid_def])


subsubsection‹Behavior vs StrongEq›

text‹It remains to clarify the role of the state invariant
$\inv_\sigma(\sigma)$ mentioned above that states the condition that
there is a ``one-to-one'' correspondence between object
representations and $\oid$'s: $\forall \mathit{oid} \in \dom\ap
\sigma\spot oid = \HolOclOidOf\ap \drop{\sigma(\mathit{oid})}$.  This
condition is also mentioned in~\cite[Annex A]{omg:ocl:2012} and goes
back to \citet{richters:precise:2002}; however, we state this
condition as an invariant on states rather than a global axiom. It
can, therefore, not be taken for granted that an $\oid$ makes sense
both in pre- and post-states of OCL expressions.
›

text‹We capture this invariant in the predicate WFF :›

definition WFF :: "('𝔄::object)st  bool"
where "WFF τ = (( x  ran(heap(fst τ)). heap(fst τ) (oid_of x) = x) 
                ( x  ran(heap(snd τ)). heap(snd τ) (oid_of x) = x))"

text‹It turns out that WFF is a key-concept for linking strict referential equality to
logical equality: in well-formed states (i.e. those states where the self (oid-of) field contains
the pointer to which the object is associated to in the state), referential equality coincides
with logical equality.›


text‹We turn now to the generic definition of referential equality on objects:
Equality on objects in a state is reduced to equality on the
references to these objects. As in HOL-OCL~\cite{brucker.ea:hol-ocl:2008,brucker.ea:hol-ocl-book:2006},
we will store the reference of an object inside the object in a (ghost) field.
By establishing certain invariants (``consistent state''), it can
be assured that there is a ``one-to-one-correspondence'' of objects
to their references---and therefore the definition below
behaves as we expect.›
text‹Generic Referential Equality enjoys the usual properties:
(quasi) reflexivity, symmetry, transitivity, substitutivity for
defined values. For type-technical reasons, for each concrete
object type, the equality ≐› is defined by generic referential
equality.›

theorem StrictRefEqObject_vs_StrongEq:
assumes WFF: "WFF τ"
and valid_x: "τ (υ x)"
and valid_y: "τ (υ y)"
and x_present_pre: "x τ  ran (heap(fst τ))"
and y_present_pre: "y τ  ran (heap(fst τ))"
and x_present_post:"x τ  ran (heap(snd τ))"
and y_present_post:"y τ  ran (heap(snd τ))"
 (* x and y must be object representations that exist in either the pre or post state *)
shows "(τ  (StrictRefEqObject x y)) = (τ  (x  y))"
apply(insert WFF valid_x valid_y x_present_pre y_present_pre x_present_post y_present_post)
apply(auto simp: StrictRefEqObject_def OclValid_def WFF_def StrongEq_def true_def Ball_def)
apply(erule_tac x="x τ" in allE', simp_all)
done

theorem StrictRefEqObject_vs_StrongEq':
assumes WFF: "WFF τ"
and valid_x: "τ (υ (x :: ('𝔄::object,::{null,object})val))"
and valid_y: "τ (υ y)"
and oid_preserve: "x. x  ran (heap(fst τ))  x  ran (heap(snd τ)) 
                        H x    oid_of (H x) = oid_of x"
and xy_together: "x τ  H ` ran (heap(fst τ))  y τ  H ` ran (heap(fst τ)) 
                  x τ  H ` ran (heap(snd τ))  y τ  H ` ran (heap(snd τ))"
 (* x and y must be object representations that exist in either the pre or post state *)
shows "(τ  (StrictRefEqObject x y)) = (τ  (x  y))"
 apply(insert WFF valid_x valid_y xy_together)
 apply(simp add: WFF_def)
 apply(auto simp: StrictRefEqObject_def OclValid_def WFF_def StrongEq_def true_def Ball_def)
by (metis foundation18' oid_preserve valid_x valid_y)+

text‹So, if two object descriptions live in the same state (both pre or post), the referential
equality on objects implies in a WFF state the logical equality.›

section‹Operations on Object›
subsection‹Initial States (for testing and code generation)›

definition τ0 :: "('𝔄)st"
where     "τ0  (heap=Map.empty, assocs = Map.empty,
                 heap=Map.empty, assocs = Map.empty)"

subsection‹OclAllInstances›

text‹To denote OCL types occurring in OCL expressions syntactically---as, for example,
as ``argument'' of \inlineocl{oclAllInstances()}---we use the inverses of the injection functions into the object
universes; we show that this is a sufficient ``characterization.''›

definition OclAllInstances_generic :: "(('𝔄::object) st  '𝔄 state)  ('𝔄::object  ) 
                                       ('𝔄,  option option) Set"
where "OclAllInstances_generic fst_snd H =
                    (λτ. Abs_Setbase  Some ` ((H ` ran (heap (fst_snd τ))) - { None }) )"

lemma OclAllInstances_generic_defined: "τ  δ (OclAllInstances_generic pre_post H)"
 apply(simp add: defined_def OclValid_def OclAllInstances_generic_def false_def true_def
                 bot_fun_def bot_Setbase_def null_fun_def null_Setbase_def)
 apply(rule conjI)
 apply(rule notI, subst (asm) Abs_Setbase_inject, simp,
       (rule disjI2)+,
       metis bot_option_def option.distinct(1),
       (simp add: bot_option_def null_option_def)+)+
done

lemma OclAllInstances_generic_init_empty:
 assumes [simp]: "x. pre_post (x, x) = x"
 shows 0  OclAllInstances_generic pre_post H  Set{}"
by(simp add: StrongEq_def OclAllInstances_generic_def OclValid_def τ0_def mtSet_def)

lemma represented_generic_objects_nonnull:
assumes A: "τ  ((OclAllInstances_generic pre_post (H::('𝔄::object  ))) ->includesSet(x))"
shows      "τ  not(x  null)"
proof -
    have B: "τ  δ (OclAllInstances_generic pre_post H)"
         by (simp add: OclAllInstances_generic_defined)
    have C: "τ  υ x"
         by (metis OclIncludes.def_valid_then_def
                   OclIncludes_valid_args_valid A foundation6)
    show ?thesis
    apply(insert A)
    apply(simp add: StrongEq_def  OclValid_def
                    OclNot_def null_def true_def OclIncludes_def B[simplified OclValid_def]
                                                                 C[simplified OclValid_def])
    apply(simp add:OclAllInstances_generic_def)
    apply(erule contrapos_pn)
    apply(subst Setbase.Abs_Setbase_inverse,
          auto simp: null_fun_def null_option_def bot_option_def)
    done
qed


lemma represented_generic_objects_defined:
assumes A: "τ  ((OclAllInstances_generic pre_post (H::('𝔄::object  ))) ->includesSet(x))"
shows      "τ  δ (OclAllInstances_generic pre_post H)  τ  δ x"
by (metis OclAllInstances_generic_defined
          A[THEN represented_generic_objects_nonnull] OclIncludes.defined_args_valid
          A foundation16' foundation18 foundation24 foundation6)


text‹One way to establish the actual presence of an object representation in a state is:›

definition "is_represented_in_state fst_snd x H τ = (x τ  (Some o H) ` ran (heap (fst_snd τ)))"

lemma represented_generic_objects_in_state:
assumes A: "τ  (OclAllInstances_generic pre_post H)->includesSet(x)"
shows      "is_represented_in_state pre_post x H τ"
proof -
   have B: "(δ (OclAllInstances_generic pre_post H)) τ = true τ"
           by(simp add: OclValid_def[symmetric] OclAllInstances_generic_defined)
   have C: "(υ x) τ = true τ"
           by (metis OclValid_def UML_Set.OclIncludes_def assms bot_option_def option.distinct(1) true_def)
   have F: "Rep_Setbase (Abs_Setbase Some ` (H ` ran (heap (pre_post τ)) - {None})) =
            Some ` (H ` ran (heap (pre_post τ)) - {None})"
           by(subst Setbase.Abs_Setbase_inverse,simp_all add: bot_option_def)
   show ?thesis
    apply(insert A)
    apply(simp add: is_represented_in_state_def OclIncludes_def OclValid_def ran_def B C image_def true_def)
    apply(simp add: OclAllInstances_generic_def)
    apply(simp add: F)
    apply(simp add: ran_def)
   by(fastforce)
qed


lemma state_update_vs_allInstances_generic_empty:
assumes [simp]: "a. pre_post (mk a) = a"
shows   "(mk heap=Map.empty, assocs=A)  OclAllInstances_generic pre_post Type  Set{}"
proof -
 have state_update_vs_allInstances_empty:
  "(OclAllInstances_generic pre_post Type) (mk heap=Map.empty, assocs=A) =
   Set{} (mk heap=Map.empty, assocs=A)"
 by(simp add: OclAllInstances_generic_def mtSet_def)
 show ?thesis
  apply(simp only: OclValid_def, subst StrictRefEqSet.cp0,
        simp only: state_update_vs_allInstances_empty StrictRefEqSet.refl_ext)
  apply(simp add: OclIf_def valid_def mtSet_def defined_def
                  bot_fun_def null_fun_def null_option_def bot_Setbase_def)
 by(subst Abs_Setbase_inject, (simp add: bot_option_def true_def)+)
qed

text‹Here comes a couple of operational rules that allow to infer the value
of \inlineisar+oclAllInstances+ from the context $\tau$. These rules are a special-case
in the sense that they are the only rules that relate statements with \emph{different}
$\tau$'s. For that reason, new concepts like ``constant contexts P'' are necessary
(for which we do not elaborate an own theory for reasons of space limitations;
 in examples, we will prove resulting constraints straight forward by hand).›


lemma state_update_vs_allInstances_generic_including':
assumes [simp]: "a. pre_post (mk a) = a"
assumes "x. σ' oid = Some x  x = Object"
    and "Type Object  None"
  shows "(OclAllInstances_generic pre_post Type)
         (mk heap=σ'(oidObject), assocs=A)
         =
         ((OclAllInstances_generic pre_post Type)->includingSet(λ _.  drop (Type Object) ))
         (mk heap=σ',assocs=A)"
proof -
 have drop_none : "x. x  None  x = x"
 by(case_tac x, simp+)

 have insert_diff : "x S. insert x (S - {None}) = (insert x S) - {None}"
 by (metis insert_Diff_if option.distinct(1) singletonE)

 show ?thesis
  apply(simp add: UML_Set.OclIncluding_def OclAllInstances_generic_defined[simplified OclValid_def],
        simp add: OclAllInstances_generic_def)
  apply(subst Abs_Setbase_inverse, simp add: bot_option_def, simp add: comp_def,
        subst image_insert[symmetric],
        subst drop_none, simp add: assms)
  apply(case_tac "Type Object", simp add: assms, simp only:,
        subst insert_diff, drule sym, simp)
  apply(subgoal_tac "ran (σ'(oid  Object)) = insert Object (ran σ')", simp)
  apply(case_tac "¬ (x. σ' oid = Some x)")
   apply(rule ran_map_upd, simp)
  apply(simp, erule exE, frule assms, simp)
  apply(subgoal_tac "Object  ran σ'") prefer 2
   apply(rule ranI, simp)
 by(subst insert_absorb, simp, metis fun_upd_apply)

qed


lemma state_update_vs_allInstances_generic_including:
assumes [simp]: "a. pre_post (mk a) = a"
assumes "x. σ' oid = Some x  x = Object"
    and "Type Object  None"
shows   "(OclAllInstances_generic pre_post Type)
         (mk heap=σ'(oidObject), assocs=A)
         =
         ((λ_. (OclAllInstances_generic pre_post Type)
                 (mk heap=σ', assocs=A))->includingSet(λ _.  drop (Type Object) ))
         (mk heap=σ'(oidObject), assocs=A)"
 apply(subst state_update_vs_allInstances_generic_including', (simp add: assms)+,
       subst UML_Set.OclIncluding.cp0,
       simp add: UML_Set.OclIncluding_def)
 apply(subst (1 3) cp_defined[symmetric],
       simp add: OclAllInstances_generic_defined[simplified OclValid_def])

 apply(simp add: defined_def OclValid_def OclAllInstances_generic_def invalid_def
                 bot_fun_def null_fun_def bot_Setbase_def null_Setbase_def)
 apply(subst (1 3) Abs_Setbase_inject)
by(simp add: bot_option_def null_option_def)+



lemma state_update_vs_allInstances_generic_noincluding':
assumes [simp]: "a. pre_post (mk a) = a"
assumes "x. σ' oid = Some x  x = Object"
    and "Type Object = None"
  shows "(OclAllInstances_generic pre_post Type)
         (mk heap=σ'(oidObject), assocs=A)
         =
         (OclAllInstances_generic pre_post Type)
         (mk heap=σ', assocs=A)"
proof -
 have drop_none : "x. x  None  x = x"
 by(case_tac x, simp+)

 have insert_diff : "x S. insert x (S - {None}) = (insert x S) - {None}"
 by (metis insert_Diff_if option.distinct(1) singletonE)

 show ?thesis
  apply(simp add: OclIncluding_def OclAllInstances_generic_defined[simplified OclValid_def]
                  OclAllInstances_generic_def)
  apply(subgoal_tac "ran (σ'(oid  Object)) = insert Object (ran σ')", simp add: assms)
  apply(case_tac "¬ (x. σ' oid = Some x)")
   apply(rule ran_map_upd, simp)
  apply(simp, erule exE, frule assms, simp)
  apply(subgoal_tac "Object  ran σ'") prefer 2
   apply(rule ranI, simp)
  apply(subst insert_absorb, simp)
 by (metis fun_upd_apply)
qed

theorem state_update_vs_allInstances_generic_ntc:
assumes [simp]: "a. pre_post (mk a) = a"
assumes oid_def:   "oiddom σ'"
and  non_type_conform: "Type Object = None "
and  cp_ctxt:      "cp P"
and  const_ctxt:   "X. const X  const (P X)"
shows "(mk heap=σ'(oidObject),assocs=A  P (OclAllInstances_generic pre_post Type)) =
       (mk heap=σ', assocs=A             P (OclAllInstances_generic pre_post Type))"
      (is "(  P ) = (?τ'  P )")
proof -
 have P_cp  : "x τ. P x τ = P (λ_. x τ) τ"
             by (metis (full_types) cp_ctxt cp_def)
 have A     : "const (P (λ_.  ))"
             by(simp add: const_ctxt const_ss)
 have       "(  P ) = (  λ_. P  )"
             by(subst foundation23, rule refl)
 also have  "... = (  λ_. P (λ_.  )  )"
             by(subst P_cp, rule refl)
 also have  "... = (?τ'  λ_. P (λ_.  )  ?τ')"
             apply(simp add: OclValid_def)
             by(subst A[simplified const_def], subst const_true[simplified const_def], simp)
 finally have X: "(  P ) = (?τ'  λ_. P (λ_.  )  ?τ')"
             by simp
 show ?thesis
 apply(subst X) apply(subst foundation23[symmetric])
 apply(rule StrongEq_L_subst3[OF cp_ctxt])
 apply(simp add: OclValid_def StrongEq_def true_def)
 apply(rule state_update_vs_allInstances_generic_noincluding')
 by(insert oid_def, auto simp: non_type_conform)
qed

theorem state_update_vs_allInstances_generic_tc:
assumes [simp]: "a. pre_post (mk a) = a"
assumes oid_def:   "oiddom σ'"
and  type_conform: "Type Object  None "
and  cp_ctxt:      "cp P"
and  const_ctxt:   "X. const X  const (P X)"
shows "(mk heap=σ'(oidObject),assocs=A  P (OclAllInstances_generic pre_post Type)) =
       (mk heap=σ', assocs=A             P ((OclAllInstances_generic pre_post Type)
                                                                ->includingSet(λ _. (Type Object))))"
       (is "(  P ) = (?τ'  P ?φ')")
proof -
 have P_cp  : "x τ. P x τ = P (λ_. x τ) τ"
             by (metis (full_types) cp_ctxt cp_def)
 have A     : "const (P (λ_.  ))"
             by(simp add: const_ctxt const_ss)
 have       "(  P ) = (  λ_. P  )"
             by(subst foundation23, rule refl)
 also have  "... = (  λ_. P (λ_.  )  )"
             by(subst P_cp, rule refl)
 also have  "... = (?τ'  λ_. P (λ_.  )  ?τ')"
             apply(simp add: OclValid_def)
             by(subst A[simplified const_def], subst const_true[simplified const_def], simp)
 finally have X: "(  P ) = (?τ'  λ_. P (λ_.  )  ?τ')"
             by simp
 let         ?allInstances = "OclAllInstances_generic pre_post Type"
 have        "?allInstances  = λ_. ?allInstances ?τ'->includingSet(λ_.Type Object) "
             apply(rule state_update_vs_allInstances_generic_including)
             by(insert oid_def, auto simp: type_conform)
 also have   "... = ((λ_. ?allInstances ?τ')->includingSet(λ_. (λ_.Type Object) ?τ') ?τ')"
             by(subst const_OclIncluding[simplified const_def], simp+)
 also have   "... = (?allInstances->includingSet(λ _. Type Object) ?τ')"
             apply(subst UML_Set.OclIncluding.cp0[symmetric])
             by(insert type_conform, auto)
 finally have Y : "?allInstances  = (?allInstances->includingSet(λ _. Type Object) ?τ')"
             by auto
 show ?thesis
      apply(subst X) apply(subst foundation23[symmetric])
      apply(rule StrongEq_L_subst3[OF cp_ctxt])
      apply(simp add: OclValid_def StrongEq_def Y true_def)
 done
qed

declare OclAllInstances_generic_def [simp]

subsubsection‹OclAllInstances (@post)›

definition OclAllInstances_at_post :: "('𝔄 :: object  )  ('𝔄,  option option) Set"
                           ("_ .allInstances'(')")
where  "OclAllInstances_at_post =  OclAllInstances_generic snd"

lemma OclAllInstances_at_post_defined: "τ  δ (H .allInstances())"
unfolding OclAllInstances_at_post_def
by(rule OclAllInstances_generic_defined)

lemma 0  H .allInstances()  Set{}"
unfolding OclAllInstances_at_post_def
by(rule OclAllInstances_generic_init_empty, simp)


lemma represented_at_post_objects_nonnull:
assumes A: "τ  (((H::('𝔄::object  )).allInstances()) ->includesSet(x))"
shows      "τ  not(x  null)"
by(rule represented_generic_objects_nonnull[OF A[simplified OclAllInstances_at_post_def]])


lemma represented_at_post_objects_defined:
assumes A: "τ  (((H::('𝔄::object  )).allInstances()) ->includesSet(x))"
shows      "τ  δ (H .allInstances())  τ  δ x"
unfolding OclAllInstances_at_post_def
by(rule represented_generic_objects_defined[OF A[simplified OclAllInstances_at_post_def]])


text‹One way to establish the actual presence of an object representation in a state is:›

lemma
assumes A: "τ  H .allInstances()->includesSet(x)"
shows      "is_represented_in_state snd x H τ"
by(rule represented_generic_objects_in_state[OF A[simplified OclAllInstances_at_post_def]])

lemma state_update_vs_allInstances_at_post_empty:
shows   "(σ, heap=Map.empty, assocs=A)  Type .allInstances()  Set{}"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_empty[OF snd_conv])

text‹Here comes a couple of operational rules that allow to infer the value
of \inlineisar+oclAllInstances+ from the context $\tau$. These rules are a special-case
in the sense that they are the only rules that relate statements with \emph{different}
$\tau$'s. For that reason, new concepts like ``constant contexts P'' are necessary
(for which we do not elaborate an own theory for reasons of space limitations;
 in examples, we will prove resulting constraints straight forward by hand).›


lemma state_update_vs_allInstances_at_post_including':
assumes "x. σ' oid = Some x  x = Object"
    and "Type Object  None"
  shows "(Type .allInstances())
         (σ, heap=σ'(oidObject), assocs=A)
         =
         ((Type .allInstances())->includingSet(λ _.  drop (Type Object) ))
         (σ, heap=σ',assocs=A)"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_including'[OF snd_conv], insert assms)


lemma state_update_vs_allInstances_at_post_including:
assumes "x. σ' oid = Some x  x = Object"
    and "Type Object  None"
shows   "(Type .allInstances())
         (σ, heap=σ'(oidObject), assocs=A)
         =
         ((λ_. (Type .allInstances())
                 (σ, heap=σ', assocs=A))->includingSet(λ _.  drop (Type Object) ))
         (σ, heap=σ'(oidObject), assocs=A)"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_including[OF snd_conv], insert assms)



lemma state_update_vs_allInstances_at_post_noincluding':
assumes "x. σ' oid = Some x  x = Object"
    and "Type Object = None"
  shows "(Type .allInstances())
         (σ, heap=σ'(oidObject), assocs=A)
         =
         (Type .allInstances())
         (σ, heap=σ', assocs=A)"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_noincluding'[OF snd_conv], insert assms)

theorem state_update_vs_allInstances_at_post_ntc:
assumes oid_def:   "oiddom σ'"
and  non_type_conform: "Type Object = None "
and  cp_ctxt:      "cp P"
and  const_ctxt:   "X. const X  const (P X)"
shows   "((σ, heap=σ'(oidObject),assocs=A)  (P(Type .allInstances()))) =
         ((σ, heap=σ', assocs=A)             (P(Type .allInstances())))"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_ntc[OF snd_conv], insert assms)

theorem state_update_vs_allInstances_at_post_tc:
assumes oid_def:   "oiddom σ'"
and  type_conform: "Type Object  None "
and  cp_ctxt:      "cp P"
and  const_ctxt:   "X. const X  const (P X)"
shows   "((σ, heap=σ'(oidObject),assocs=A)  (P(Type .allInstances()))) =
         ((σ, heap=σ', assocs=A)             (P((Type .allInstances())
                                                               ->includingSet(λ _. (Type Object)))))"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_tc[OF snd_conv], insert assms)

subsubsection‹OclAllInstances (@pre)›

definition OclAllInstances_at_pre :: "('𝔄 :: object  )  ('𝔄,  option option) Set"
                           ("_ .allInstances@pre'(')")
where  "OclAllInstances_at_pre = OclAllInstances_generic fst"

lemma OclAllInstances_at_pre_defined: "τ  δ (H .allInstances@pre())"
unfolding OclAllInstances_at_pre_def
by(rule OclAllInstances_generic_defined)

lemma 0  H .allInstances@pre()  Set{}"
unfolding OclAllInstances_at_pre_def
by(rule OclAllInstances_generic_init_empty, simp)


lemma represented_at_pre_objects_nonnull:
assumes A: "τ  (((H::('𝔄::object  )).allInstances@pre()) ->includesSet(x))"
shows      "τ  not(x  null)"
by(rule represented_generic_objects_nonnull[OF A[simplified OclAllInstances_at_pre_def]])

lemma represented_at_pre_objects_defined:
assumes A: "τ  (((H::('𝔄::object  )).allInstances@pre()) ->includesSet(x))"
shows      "τ  δ (H .allInstances@pre())  τ  δ x"
unfolding OclAllInstances_at_pre_def
by(rule represented_generic_objects_defined[OF A[simplified OclAllInstances_at_pre_def]])


text‹One way to establish the actual presence of an object representation in a state is:›

lemma
assumes A: "τ  H .allInstances@pre()->includesSet(x)"
shows      "is_represented_in_state fst x H τ"
by(rule represented_generic_objects_in_state[OF A[simplified OclAllInstances_at_pre_def]])


lemma state_update_vs_allInstances_at_pre_empty:
shows   "(heap=Map.empty, assocs=A, σ)  Type .allInstances@pre()  Set{}"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_empty[OF fst_conv])

text‹Here comes a couple of operational rules that allow to infer the value
of \inlineisar+oclAllInstances@pre+ from the context $\tau$. These rules are a special-case
in the sense that they are the only rules that relate statements with \emph{different}
$\tau$'s. For that reason, new concepts like ``constant contexts P'' are necessary
(for which we do not elaborate an own theory for reasons of space limitations;
 in examples, we will prove resulting constraints straight forward by hand).›


lemma state_update_vs_allInstances_at_pre_including':
assumes "x. σ' oid = Some x  x = Object"
    and "Type Object  None"
  shows "(Type .allInstances@pre())
         (heap=σ'(oidObject), assocs=A, σ)
         =
         ((Type .allInstances@pre())->includingSet(λ _.  drop (Type Object) ))
         (heap=σ',assocs=A, σ)"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_including'[OF fst_conv], insert assms)


lemma state_update_vs_allInstances_at_pre_including:
assumes "x. σ' oid = Some x  x = Object"
    and "Type Object  None"
shows   "(Type .allInstances@pre())
         (heap=σ'(oidObject), assocs=A, σ)
         =
         ((λ_. (Type .allInstances@pre())
                 (heap=σ', assocs=A, σ))->includingSet(λ _.  drop (Type Object) ))
         (heap=σ'(oidObject), assocs=A, σ)"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_including[OF fst_conv], insert assms)



lemma state_update_vs_allInstances_at_pre_noincluding':
assumes "x. σ' oid = Some x  x = Object"
    and "Type Object = None"
  shows "(Type .allInstances@pre())
         (heap=σ'(oidObject), assocs=A, σ)
         =
         (Type .allInstances@pre())
         (heap=σ', assocs=A, σ)"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_noincluding'[OF fst_conv], insert assms)

theorem state_update_vs_allInstances_at_pre_ntc:
assumes oid_def:   "oiddom σ'"
and  non_type_conform: "Type Object = None "
and  cp_ctxt:      "cp P"
and  const_ctxt:   "X. const X  const (P X)"
shows   "((heap=σ'(oidObject),assocs=A, σ)  (P(Type .allInstances@pre()))) =
         ((heap=σ', assocs=A, σ)             (P(Type .allInstances@pre())))"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_ntc[OF fst_conv], insert assms)

theorem state_update_vs_allInstances_at_pre_tc:
assumes oid_def:   "oiddom σ'"
and  type_conform: "Type Object  None "
and  cp_ctxt:      "cp P"
and  const_ctxt:   "X. const X  const (P X)"
shows   "((heap=σ'(oidObject),assocs=A, σ)  (P(Type .allInstances@pre()))) =
         ((heap=σ', assocs=A, σ)             (P((Type .allInstances@pre())
                                                               ->includingSet(λ _. (Type Object)))))"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_tc[OF fst_conv], insert assms)

subsubsection‹@post or @pre›

theorem StrictRefEqObject_vs_StrongEq'':
assumes WFF: "WFF τ"
and valid_x: "τ (υ (x :: ('𝔄::object,::object option option)val))"
and valid_y: "τ (υ y)"
and oid_preserve: "x. x  ran (heap(fst τ))  x  ran (heap(snd τ)) 
                        oid_of (H x) = oid_of x"
and xy_together: "τ  ((H .allInstances()->includesSet(x) and H .allInstances()->includesSet(y)) or
                       (H .allInstances@pre()->includesSet(x) and H .allInstances@pre()->includesSet(y)))"
 (* x and y must be object representations that exist in either the pre or post state *)
shows "(τ  (StrictRefEqObject x y)) = (τ  (x  y))"
proof -
   have at_post_def : "x. τ  υ x  τ  δ (H .allInstances()->includesSet(x))"
    apply(simp add: OclIncludes_def OclValid_def
                    OclAllInstances_at_post_defined[simplified OclValid_def])
   by(subst cp_defined, simp)
   have at_pre_def : "x. τ  υ x  τ  δ (H .allInstances@pre()->includesSet(x))"
    apply(simp add: OclIncludes_def OclValid_def
                    OclAllInstances_at_pre_defined[simplified OclValid_def])
   by(subst cp_defined, simp)
   have F: "Rep_Setbase (Abs_Setbase Some ` (H ` ran (heap (fst τ)) - {None})) =
            Some ` (H ` ran (heap (fst τ)) - {None})"
           by(subst Setbase.Abs_Setbase_inverse,simp_all add: bot_option_def)
   have F': "Rep_Setbase (Abs_Setbase Some ` (H ` ran (heap (snd τ)) - {None})) =
            Some ` (H ` ran (heap (snd τ)) - {None})"
           by(subst Setbase.Abs_Setbase_inverse,simp_all add: bot_option_def)
 show ?thesis
  apply(rule StrictRefEqObject_vs_StrongEq'[OF WFF valid_x valid_y, where H = "Some o H"])
  apply(subst oid_preserve[symmetric], simp, simp add: oid_of_option_def)
  apply(insert xy_together,
        subst (asm) foundation11,
        metis at_post_def defined_and_I valid_x valid_y,
        metis at_pre_def defined_and_I valid_x valid_y)
  apply(erule disjE)
 by(drule foundation5,
    simp add: OclAllInstances_at_pre_def OclAllInstances_at_post_def
              OclValid_def OclIncludes_def true_def F F'
              valid_x[simplified OclValid_def] valid_y[simplified OclValid_def] bot_option_def
         split: if_split_asm,
    simp add: comp_def image_def, fastforce)+
qed

subsection‹OclIsNew, OclIsDeleted, OclIsMaintained, OclIsAbsent›

definition OclIsNew:: "('𝔄, ::{null,object})val  ('𝔄)Boolean"   ("(_).oclIsNew'(')")
where "X .oclIsNew()  (λτ . if (δ X) τ = true τ
                              then oid_of (X τ)  dom(heap(fst τ)) 
                                     oid_of (X τ)  dom(heap(snd τ))
                              else invalid τ)"

text‹The following predicates --- which are not part of the OCL standard descriptions ---
complete the goal of \inlineisar+oclIsNew+ by describing where an object belongs.
›

definition OclIsDeleted:: "('𝔄, ::{null,object})val  ('𝔄)Boolean"   ("(_).oclIsDeleted'(')")
where "X .oclIsDeleted()  (λτ . if (δ X) τ = true τ
                              then oid_of (X τ)  dom(heap(fst τ)) 
                                     oid_of (X τ)  dom(heap(snd τ))
                              else invalid τ)"

definition OclIsMaintained:: "('𝔄, ::{null,object})val  ('𝔄)Boolean"("(_).oclIsMaintained'(')")
where "X .oclIsMaintained()  (λτ . if (δ X) τ = true τ
                              then oid_of (X τ)  dom(heap(fst τ)) 
                                     oid_of (X τ)  dom(heap(snd τ))
                              else invalid τ)"

definition OclIsAbsent:: "('𝔄, ::{null,object})val  ('𝔄)Boolean"   ("(_).oclIsAbsent'(')")
where "X .oclIsAbsent()  (λτ . if (δ X) τ = true τ
                              then oid_of (X τ)  dom(heap(fst τ)) 
                                     oid_of (X τ)  dom(heap(snd τ))
                              else invalid τ)"

lemma state_split : "τ  δ X 
                     τ  (X .oclIsNew())  τ  (X .oclIsDeleted()) 
                     τ  (X .oclIsMaintained())  τ  (X .oclIsAbsent())"
by(simp add: OclIsDeleted_def OclIsNew_def OclIsMaintained_def OclIsAbsent_def
             OclValid_def true_def, blast)

lemma notNew_vs_others : "τ  δ X 
                         (¬ τ  (X .oclIsNew())) = (τ  (X .oclIsDeleted()) 
                          τ  (X .oclIsMaintained())  τ  (X .oclIsAbsent()))"
by(simp add: OclIsDeleted_def OclIsNew_def OclIsMaintained_def OclIsAbsent_def
                OclNot_def OclValid_def true_def, blast)

subsection‹OclIsModifiedOnly›
subsubsection‹Definition›

text‹The following predicate---which is not part of the OCL
standard---provides a simple, but powerful means to describe framing
conditions. For any formal approach, be it animation of OCL contracts,
test-case generation or die-hard theorem proving, the specification of
the part of a system transition that \emph{does not change} is of
primordial importance. The following operator establishes the equality
between old and new objects in the state (provided that they exist in
both states), with the exception of those objects.›

definition OclIsModifiedOnly ::"('𝔄::object,::{null,object})Set  '𝔄 Boolean"
                        ("_->oclIsModifiedOnly'(')")
where "X->oclIsModifiedOnly()  (λ(σ,σ').
                           let X' = (oid_of ` Rep_Setbase(X(σ,σ')));
                               S = ((dom (heap σ)  dom (heap σ')) - X')
                           in if (δ X) (σ,σ') = true (σ,σ')  (xRep_Setbase(X(σ,σ')). x  null)
                              then  x  S. (heap σ) x = (heap σ') x
                              else invalid (σ,σ'))"

subsubsection‹Execution with Invalid or Null or Null Element as Argument›

lemma "invalid->oclIsModifiedOnly() = invalid"
by(simp add: OclIsModifiedOnly_def)

lemma "null->oclIsModifiedOnly() = invalid"
by(simp add: OclIsModifiedOnly_def)

lemma
 assumes X_null : "τ  X->includesSet(null)"
 shows "τ  X->oclIsModifiedOnly()  invalid"
 apply(insert X_null,
       simp add : OclIncludes_def OclIsModifiedOnly_def StrongEq_def OclValid_def true_def)
 apply(case_tac τ, simp)
 apply(simp split: if_split_asm)
by(simp add: null_fun_def, blast)

subsubsection‹Context Passing›

lemma cp_OclIsModifiedOnly : "X->oclIsModifiedOnly() τ = (λ_. X τ)->oclIsModifiedOnly() τ"
by(simp only: OclIsModifiedOnly_def, case_tac τ, simp only:, subst cp_defined, simp)

subsection‹OclSelf›

text‹The following predicate---which is not part of the OCL
standard---explicitly retrieves in the pre or post state the original OCL expression
given as argument.›

definition [simp]: "OclSelf x H fst_snd = (λτ . if (δ x) τ = true τ
                        then if oid_of (x τ)  dom(heap(fst τ))  oid_of (x τ)  dom(heap (snd τ))
                             then  H (heap(fst_snd τ))(oid_of (x τ))
                             else invalid τ
                        else invalid τ)"

definition OclSelf_at_pre :: "('𝔄::object,::{null,object})val 
                      ('𝔄  ) 
                      ('𝔄::object,::{null,object})val" ("(_)@pre(_)")
where "x @pre H = OclSelf x H fst"

definition OclSelf_at_post :: "('𝔄::object,::{null,object})val 
                      ('𝔄  ) 
                      ('𝔄::object,::{null,object})val" ("(_)@post(_)")
where "x @post H = OclSelf x H snd"

subsection‹Framing Theorem›

lemma all_oid_diff:
 assumes def_x : "τ  δ x"
 assumes def_X : "τ  δ X"
 assumes def_X' : "x. x  Rep_Setbase (X τ)  x  null"

 defines "P  (λa. not (StrictRefEqObject x a))"
 shows "(τ  X->forAllSet(a| P a)) = (oid_of (x τ)  oid_of ` Rep_Setbase (X τ))"
proof -
 have P_null_bot: "b. b = null  b =  
                        ¬ (xRep_Setbase (X τ). P (λ(_:: 'a state × 'a state). x) τ = b τ)"
  apply(erule disjE)
   apply(simp, rule ballI,
         simp add: P_def StrictRefEqObject_def, rename_tac x',
         subst cp_OclNot, simp,
         subgoal_tac "x τ  null  x'  null", simp,
         simp add: OclNot_def null_fun_def null_option_def bot_option_def bot_fun_def invalid_def,
         ( metis def_X' def_x foundation16[THEN iffD1]
         | (metis bot_fun_def OclValid_def Set_inv_lemma def_X def_x defined_def valid_def,
            metis def_X' def_x foundation16[THEN iffD1])))+
 done


 have not_inj : "x y. ((not x) τ = (not y) τ) = (x τ = y τ)"
 by (metis foundation21 foundation22)

 have P_false : "xRep_Setbase (X τ). P (λ_. x) τ = false τ 
                 oid_of (x τ)  oid_of ` Rep_Setbase (X τ)"
  apply(erule bexE, rename_tac x')
  apply(simp add: P_def)
  apply(simp only: OclNot3[symmetric], simp only: not_inj)
  apply(simp add: StrictRefEqObject_def split: if_split_asm)
    apply(subgoal_tac "x τ  null  x'  null", simp)
    apply (metis (mono_tags) drop.simps def_x foundation16[THEN iffD1] true_def)
 by(simp add: invalid_def bot_option_def true_def)+

 have P_true : "xRep_Setbase (X τ). P (λ_. x) τ = true τ 
                oid_of (x τ)  oid_of ` Rep_Setbase (X τ)"
  apply(subgoal_tac "x'Rep_Setbase (X τ). oid_of x'  oid_of (x τ)")
   apply (metis imageE)
  apply(rule ballI, drule_tac x = "x'" in ballE) prefer 3 apply assumption
   apply(simp add: P_def)
   apply(simp only: OclNot4[symmetric], simp only: not_inj)
   apply(simp add: StrictRefEqObject_def false_def split: if_split_asm)
    apply(subgoal_tac "x τ  null  x'  null", simp)
    apply (metis def_X' def_x  foundation16[THEN iffD1])
 by(simp add: invalid_def bot_option_def false_def)+

 have bool_split : "xRep_Setbase (X τ). P (λ_. x) τ  null τ 
                    xRep_Setbase (X τ). P (λ_. x) τ   τ 
                    xRep_Setbase (X τ). P (λ_. x) τ  false τ 
                    xRep_Setbase (X τ). P (λ_. x) τ = true τ"
  apply(rule ballI)
  apply(drule_tac x = x in ballE) prefer 3 apply assumption
   apply(drule_tac x = x in ballE) prefer 3 apply assumption
    apply(drule_tac x = x in ballE) prefer 3 apply assumption
     apply (metis (full_types) bot_fun_def OclNot4 OclValid_def foundation16
                               foundation9 not_inj null_fun_def)
 by(fast+)

 show ?thesis
  apply(subst OclForall_rep_set_true[OF def_X], simp add: OclValid_def)
  apply(rule iffI, simp add: P_true)
 by (metis P_false P_null_bot bool_split)
qed

theorem framing:
      assumes modifiesclause:"τ  (X->excludingSet(x))->oclIsModifiedOnly()"
      and oid_is_typerepr : "τ  X->forAllSet(a| not (StrictRefEqObject x a))"
      shows "τ  (x @pre P    (x @post P))"
 apply(case_tac "τ  δ x")
 proof - show "τ  δ x  ?thesis" proof - assume def_x : "τ  δ x" show ?thesis proof -

 have def_X : "τ  δ X"
  apply(insert oid_is_typerepr, simp add: UML_Set.OclForall_def OclValid_def split: if_split_asm)
 by(simp add: bot_option_def true_def)

 have def_X' : "x. x  Rep_Setbase (X τ)  x  null"
  apply(insert modifiesclause, simp add: OclIsModifiedOnly_def OclValid_def split: if_split_asm)
  apply(case_tac τ, simp split: if_split_asm)
   apply(simp add: UML_Set.OclExcluding_def split: if_split_asm)
    apply(subst (asm) (2) Abs_Setbase_inverse)
     apply(simp, (rule disjI2)+)
     apply (metis (hide_lams, mono_tags) Diff_iff Set_inv_lemma def_X)
    apply(simp)
    apply(erule ballE[where P = "λx. x  null"]) apply(assumption)
    apply(simp)
    apply (metis (hide_lams, no_types) def_x  foundation16[THEN iffD1])
   apply (metis (hide_lams, no_types) OclValid_def def_X def_x foundation20
                                      OclExcluding_valid_args_valid OclExcluding_valid_args_valid'')
 by(simp add: invalid_def bot_option_def)

 have oid_is_typerepr : "oid_of (x τ)  oid_of ` Rep_Setbase (X τ)"
 by(rule all_oid_diff[THEN iffD1, OF def_x def_X def_X' oid_is_typerepr])

 show ?thesis
  apply(simp add: StrongEq_def OclValid_def true_def OclSelf_at_pre_def OclSelf_at_post_def
                  def_x[simplified OclValid_def])
  apply(rule conjI, rule impI)
   apply(rule_tac f = "λx. P x" in arg_cong)
   apply(insert modifiesclause[simplified OclIsModifiedOnly_def OclValid_def])
   apply(case_tac τ, rename_tac σ σ', simp split: if_split_asm)
    apply(subst (asm) (2) UML_Set.OclExcluding_def)
    apply(drule foundation5[simplified OclValid_def true_def], simp)
    apply(subst (asm) Abs_Setbase_inverse, simp)
     apply(rule disjI2)+
     apply (metis (hide_lams, no_types) DiffD1 OclValid_def Set_inv_lemma def_x
                                        foundation16 foundation18')
    apply(simp)
    apply(erule_tac x = "oid_of (x (σ, σ'))" in ballE) apply simp+
    apply (metis (hide_lams, no_types)
                 DiffD1 image_iff image_insert insert_Diff_single insert_absorb oid_is_typerepr)
   apply(simp add: invalid_def bot_option_def)+
 by blast
 qed qed
qed(simp add: OclSelf_at_post_def OclSelf_at_pre_def OclValid_def StrongEq_def true_def)+


text‹As corollary, the framing property can be expressed with only the strong equality
as comparison operator.›

theorem framing':
  assumes wff : "WFF τ"
  assumes modifiesclause:"τ  (X->excludingSet(x))->oclIsModifiedOnly()"
  and oid_is_typerepr : "τ  X->forAllSet(a| not (x  a))"
  and oid_preserve: "x. x  ran (heap(fst τ))  x  ran (heap(snd τ)) 
                          oid_of (H x) = oid_of x"
  and xy_together:
  "τ  X->forAllSet(y | (H .allInstances()->includesSet(x) and H .allInstances()->includesSet(y)) or
                     (H .allInstances@pre()->includesSet(x) and H .allInstances@pre()->includesSet(y)))"
  shows "τ  (x @pre P    (x @post P))"
proof -
 have def_X : "τ  δ X"
  apply(insert oid_is_typerepr, simp add: UML_Set.OclForall_def OclValid_def split: if_split_asm)
 by(simp add: bot_option_def true_def)
 show ?thesis
  apply(case_tac "τ  δ x", drule foundation20)
   apply(rule framing[OF modifiesclause])
   apply(rule OclForall_cong'[OF _ oid_is_typerepr xy_together], rename_tac y)
   apply(cut_tac Set_inv_lemma'[OF def_X]) prefer 2 apply assumption
   apply(rule OclNot_contrapos_nn, simp add: StrictRefEqObject_def)
     apply(simp add: OclValid_def, subst cp_defined, simp,
           assumption)
   apply(rule StrictRefEqObject_vs_StrongEq''[THEN iffD1, OF wff _ _ oid_preserve], assumption+)
 by(simp add: OclSelf_at_post_def OclSelf_at_pre_def OclValid_def StrongEq_def true_def)+
qed

subsection‹Miscellaneous›

lemma pre_post_new: "τ  (x .oclIsNew())  ¬ (τ  υ(x @pre H1))  ¬ (τ  υ(x @post H2))"
by(simp add: OclIsNew_def OclSelf_at_pre_def OclSelf_at_post_def
             OclValid_def StrongEq_def true_def false_def
             bot_option_def invalid_def bot_fun_def valid_def
      split: if_split_asm)

lemma pre_post_old: "τ  (x .oclIsDeleted())  ¬ (τ  υ(x @pre H1))  ¬ (τ  υ(x @post H2))"
by(simp add: OclIsDeleted_def OclSelf_at_pre_def OclSelf_at_post_def
             OclValid_def StrongEq_def true_def false_def
             bot_option_def invalid_def bot_fun_def valid_def
      split: if_split_asm)

lemma pre_post_absent: "τ  (x .oclIsAbsent())  ¬ (τ  υ(x @pre H1))  ¬ (τ  υ(x @post H2))"
by(simp add: OclIsAbsent_def OclSelf_at_pre_def OclSelf_at_post_def
             OclValid_def StrongEq_def true_def false_def
             bot_option_def invalid_def bot_fun_def valid_def
      split: if_split_asm)

lemma pre_post_maintained: "(τ  υ(x @pre H1)  τ  υ(x @post H2))  τ  (x .oclIsMaintained())"
by(simp add: OclIsMaintained_def OclSelf_at_pre_def OclSelf_at_post_def
             OclValid_def StrongEq_def true_def false_def
             bot_option_def invalid_def bot_fun_def valid_def
      split: if_split_asm)

lemma pre_post_maintained':
"τ  (x .oclIsMaintained())  (τ  υ(x @pre (Some o H1))  τ  υ(x @post (Some o H2)))"
by(simp add: OclIsMaintained_def OclSelf_at_pre_def OclSelf_at_post_def
             OclValid_def StrongEq_def true_def false_def
             bot_option_def invalid_def bot_fun_def valid_def
      split: if_split_asm)

lemma framing_same_state: "(σ, σ)  (x @pre H    (x @post H))"
by(simp add: OclSelf_at_pre_def OclSelf_at_post_def OclValid_def StrongEq_def)

section‹Accessors on Object›
subsection‹Definition›

definition "select_object mt incl smash deref l = smash (foldl incl mt (map deref l))
 ― ‹smash returns null with mt› in input (in this case, object contains null pointer)›"

text‹The continuation f› is usually instantiated with a smashing
function which is either the identity @{term id} or, for \inlineocl{0..1} cardinalities
of associations, the @{term OclANY}-selector which also handles the
@{term null}-cases appropriately. A standard use-case for this combinator
is for example:›
term "(select_object mtSet UML_Set.OclIncluding UML_Set.OclANY f  l oid )::('𝔄, 'a::null)val"

definition "select_objectSet = select_object mtSet UML_Set.OclIncluding id"
definition "select_object_any0Set f s_set = UML_Set.OclANY (select_objectSet f s_set)"
definition "select_object_anySet f s_set = 
 (let s = select_objectSet f s_set in
  if s->sizeSet()  𝟭 then
    s->anySet()
  else
    
  endif)"
definition "select_objectSeq = select_object mtSequence UML_Sequence.OclIncluding id"
definition "select_object_anySeq f s_set = UML_Sequence.OclANY (select_objectSeq f s_set)"
definition "select_objectPair f1 f2 = (λ(a,b). OclPair (f1 a) (f2 b))"

subsection‹Validity and Definedness Properties›

lemma select_fold_execSeq:
 assumes "list_all (λf. (τ  υ f)) l"
 shows "Rep_Sequencebase (foldl UML_Sequence.OclIncluding Sequence{} l τ) = List.map (λf. f τ) l"
proof -
 have def_fold: "l. list_all (λf. τ  υ f) l 
            τ  (δ foldl UML_Sequence.OclIncluding Sequence{} l)"
  apply(rule rev_induct[where P = "λl. list_all (λf. (τ  υ f)) l  τ  (δ foldl UML_Sequence.OclIncluding Sequence{} l)", THEN mp], simp)
 by(simp add: foundation10')
 show ?thesis
  apply(rule rev_induct[where P = "λl. list_all (λf. (τ  υ f)) l  Rep_Sequencebase (foldl UML_Sequence.OclIncluding Sequence{} l τ) = List.map (λf. f τ) l", THEN mp], simp)
    apply(simp add: mtSequence_def)
    apply(subst Abs_Sequencebase_inverse, (simp | intro impI)+)
   apply(simp add: UML_Sequence.OclIncluding_def, intro conjI impI)
    apply(subst Abs_Sequencebase_inverse, simp, (rule disjI2)+)
     apply(simp add: list_all_iff foundation18', simp)
   apply(subst (asm) def_fold[simplified (no_asm) OclValid_def], simp, simp add: OclValid_def)
 by (rule assms)
qed

lemma select_fold_execSet:
 assumes "list_all (λf. (τ  υ f)) l"
 shows "Rep_Setbase (foldl UML_Set.OclIncluding Set{} l τ) = set (List.map (λf. f τ) l)"
proof -
 have def_fold: "l. list_all (λf. τ  υ f) l 
            τ  (δ foldl UML_Set.OclIncluding Set{} l)"
  apply(rule rev_induct[where P = "λl. list_all (λf. (τ  υ f)) l  τ  (δ foldl UML_Set.OclIncluding Set{} l)", THEN mp], simp)
 by(simp add: foundation10')
 show ?thesis
  apply(rule rev_induct[where P = "λl. list_all (λf. (τ  υ f)) l  Rep_Setbase (foldl UML_Set.OclIncluding Set{} l τ) = set (List.map (λf. f τ) l)", THEN mp], simp)
    apply(simp add: mtSet_def)
    apply(subst Abs_Setbase_inverse, (simp | intro impI)+)
   apply(simp add: UML_Set.OclIncluding_def, intro conjI impI)
    apply(subst Abs_Setbase_inverse, simp, (rule disjI2)+)
     apply(simp add: list_all_iff foundation18', simp)
   apply(subst (asm) def_fold[simplified (no_asm) OclValid_def], simp, simp add: OclValid_def)
 by (rule assms)
qed

lemma fold_val_elemSeq:
 assumes "τ  υ (foldl UML_Sequence.OclIncluding Sequence{} (List.map (f p) s_set))"
 shows "list_all (λx. (τ  υ (f p x))) s_set"
 apply(rule rev_induct[where P = "λs_set. τ  υ foldl UML_Sequence.OclIncluding Sequence{} (List.map (f p) s_set)  list_all (λx. τ  υ f p x) s_set", THEN mp])
   apply(simp, auto)
    apply (metis (hide_lams, mono_tags) UML_Sequence.OclIncluding.def_valid_then_def UML_Sequence.OclIncluding.defined_args_valid foundation20)+
by(simp add: assms)

lemma fold_val_elemSet:
 assumes "τ  υ (foldl UML_Set.OclIncluding Set{} (List.map (f p) s_set))"
 shows "list_all (λx. (τ  υ (f p x))) s_set"
 apply(rule rev_induct[where P = "λs_set. τ  υ foldl UML_Set.OclIncluding Set{} (List.map (f p) s_set)  list_all (λx. τ  υ f p x) s_set", THEN mp])
   apply(simp, auto)
    apply (metis (hide_lams, mono_tags) foundation10' foundation20)+
by(simp add: assms)

lemma select_object_any_definedSeq:
 assumes def_sel: "τ  δ (select_object_anySeq f s_set)"
 shows "s_set  []"
 apply(insert def_sel, case_tac s_set)
  apply(simp add: select_object_anySeq_def UML_Sequence.OclANY_def select_objectSeq_def select_object_def
                  defined_def OclValid_def
                  false_def true_def bot_fun_def bot_option_def
             split: if_split_asm)
  apply(simp add: mtSequence_def, subst (asm) Abs_Sequencebase_inverse, simp, simp)
by(simp)

lemma (*select_object_any_definedSet:*)
 assumes def_sel: "τ  δ (select_object_any0Set f s_set)"
 shows "s_set  []"
 apply(insert def_sel, case_tac s_set)
  apply(simp add: select_object_any0Set_def UML_Sequence.OclANY_def select_objectSet_def select_object_def
                  defined_def OclValid_def
                  false_def true_def bot_fun_def bot_option_def
             split: if_split_asm)
by(simp)

lemma select_object_any_definedSet:
 assumes def_sel: "τ  δ (select_object_anySet f s_set)"
 shows "s_set  []"
 apply(insert def_sel, case_tac s_set)
  apply(simp add: select_object_anySet_def UML_Sequence.OclANY_def select_objectSet_def select_object_def
                  defined_def OclValid_def
                  false_def true_def bot_fun_def bot_option_def
                  OclInt0_def OclInt1_def StrongEq_def OclIf_def null_fun_def null_option_def
             split: if_split_asm)
by(simp)

lemma select_object_any_exec0Seq:
 assumes def_sel: "τ  δ (select_object_anySeq f s_set)"
 shows "τ  (select_object_anySeq f s_set  f (hd s_set))"
  apply(insert def_sel[simplified foundation16],
        simp add: select_object_anySeq_def foundation22 UML_Sequence.OclANY_def split: if_split_asm)
  apply(case_tac "Rep_Sequencebase (select_objectSeq f s_set τ)", simp add: bot_option_def, simp)
  apply(simp add: select_objectSeq_def select_object_def)
  apply(subst (asm) select_fold_execSeq)
   apply(rule fold_val_elemSeq, simp add: foundation18' invalid_def)
  apply(simp)
by(drule arg_cong[where f = hd], subst (asm) hd_map, simp add: select_object_any_definedSeq[OF def_sel], simp)

lemma select_object_any_execSeq:
 assumes def_sel: "τ  δ (select_object_anySeq f s_set)"
 shows "e. List.member s_set e  (τ  (select_object_anySeq f s_set  f e))"
 apply(insert select_object_any_exec0Seq[OF def_sel])
 apply(rule exI[where x = "hd s_set"], simp)
 apply(case_tac s_set, simp add: select_object_any_definedSeq[OF def_sel])
by (metis list.sel member_rec(1))

lemma (*select_object_any_execSet:*)
 assumes def_sel: "τ  δ (select_object_any0Set f s_set)"
 shows " e. List.member s_set e  (τ  (select_object_any0Set f s_set  f e))"
proof -
 have list_all_map: "P f l. list_all P (List.map f l) = list_all (P o f) l"
 by(induct_tac l, simp_all)

 fix z
 show ?thesis
  when "Rep_Setbase (select_objectSet f s_set τ) = z"
  apply(insert that def_sel[simplified foundation16],
        simp add: select_object_any0Set_def foundation22 UML_Set.OclANY_def null_fun_def split: if_split_asm)

  apply(simp add: select_objectSet_def select_object_def)
  apply(subst (asm) select_fold_execSet)
   apply(rule fold_val_elemSet, simp add: OclValid_def)
  apply(simp add: comp_def)

  apply(case_tac s_set, simp, simp add: false_def true_def, simp)

  proof - fix a l
  show "insert (f a τ) ((λx. f x τ) ` set l) = z 
        e. List.member (a # l) e  (SOME y. y  z) = f e τ"
   apply(rule list.induct[where P = "λl. z a. insert (f a τ) ((λx. f x τ) ` set l) = z 
        (e. List.member (a # l) e  ((SOME y. y  z) = f e τ))", THEN spec, THEN spec, THEN mp], intro allI impI)
     proof - fix x xa show "insert (f xa τ) ((λx. f x τ) ` set []) = x  e. List.member [xa] e  (SOME y. y  x) = f e τ"
      apply(rule exI[where x = xa], simp add: List.member_def)
      apply(subst some_equality[where a = "f xa τ"])
        apply (metis (mono_tags) insertI1)
       apply (metis (mono_tags) empty_iff insert_iff)
     by(simp)
    apply_end(intro allI impI, simp)
    fix x list xa xb
    show " x. e. List.member (x # list) e  (SOME y. y = f x τ  y  (λx. f x τ) ` set list) = f e τ 
       insert (f xb τ) (insert (f x τ) ((λx. f x τ) ` set list)) = xa 
       e. List.member (xb # x # list) e  (SOME y. y  xa) = f e τ"
     apply(case_tac "x = xb", simp)
      apply(erule allE[where x = xb])
      apply(erule exE)
      proof - fix e show "insert (f xb τ) ((λx. f x τ) ` set list) = xa 
         x = xb 
         List.member (xb # list) e  (SOME y. y = f xb τ  y  (λx. f x τ) ` set list) = f e τ 
         e. List.member (xb # xb # list) e  (SOME y. y  xa) = f e τ"
      apply(rule exI[where x = e], auto)
      by (metis member_rec(1))
     apply_end(case_tac "List.member list x")
      apply_end(erule allE[where x = xb])
      apply_end(erule exE)
      fix e
      let ?P = "λy. y = f xb τ  y  (λx. f x τ) ` set list"
      show "insert (f xb τ) (insert (f x τ) ((λx. f x τ) ` set list)) = xa 
         x  xb 
         List.member list x 
         List.member (xb # list) e  (SOME y. y = f xb τ  y  (λx. f x τ) ` set list) = f e τ 
         e. List.member (xb # x # list) e  (SOME y. y  xa) = f e τ"
       apply(rule exI[where x = e], auto)
        apply (metis member_rec(1))

       apply(subgoal_tac "?P (f e τ)")
        prefer 2
        apply(case_tac "xb = e", simp)
        apply (metis (mono_tags) image_eqI in_set_member member_rec(1)) 

       apply(rule someI2[where a = "f e τ"])
        apply(erule disjE, simp)+
        apply(rule disjI2)+ apply(simp)
oops

lemma select_object_any_execSet:
 assumes def_sel: "τ  δ (select_object_anySet f s_set)"
 shows " e. List.member s_set e  (τ  (select_object_anySet f s_set  f e))"
proof -
 have card_singl: "A a. finite A  card (insert a A) = 1  A  {a}"
 by (auto, metis Suc_inject card_Suc_eq card_eq_0_iff insert_absorb insert_not_empty singleton_iff)

 have list_same: "f s_set z' x. f ` set s_set = {z'}  List.member s_set x  f x = z'"
 by (metis (full_types) empty_iff imageI in_set_member insert_iff)

 fix z
 show ?thesis
  when "Rep_Setbase (select_objectSet f s_set τ) = z"
  apply(insert that def_sel[simplified foundation16],
        simp add: select_object_anySet_def foundation22
                  Let_def null_fun_def bot_fun_def OclIf_def
             split: if_split_asm)
  apply(simp add: StrongEq_def OclInt1_def true_def UML_Set.OclSize_def
                  bot_option_def UML_Set.OclANY_def null_fun_def
                  split: if_split_asm)
  apply(subgoal_tac "z'. z = {z'}")
   prefer 2
   apply(rule finite.cases[where a = z], simp, simp, simp)
   apply(rule card_singl, simp, simp)
  apply(erule exE, clarsimp)

  apply(simp add: select_objectSet_def select_object_def)
  apply(subst (asm) select_fold_execSet)
   apply(rule fold_val_elemSet, simp add: OclValid_def true_def)
  apply(simp add: comp_def)

  apply(case_tac s_set, simp)
  proof - fix z' a list show "(λx. f x τ) ` set s_set = {z'}  s_set = a # list  e. List.member s_set e  z' = f e τ"
    apply(drule list_same[where x1 = a])
     apply (metis member_rec(1))
   by (metis (hide_lams, mono_tags) ListMem_iff elem in_set_member)
  qed
qed blast+

end

Theory UML_Contracts

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Contracts.thy ---
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2013-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

theory UML_Contracts
imports UML_State
begin

text‹Modeling of an operation contract for an operation  with 2 arguments,
       (so depending on three parameters if one takes "self" into account).›

locale contract_scheme =
   fixes f_υ
   fixes f_lam
   fixes f   :: "('𝔄,'α0::null)val  
                 'b 
                  ('𝔄,'res::null)val"
   fixes PRE
   fixes POST
   assumes def_scheme': "f self x   (λ τ. SOME res. let res = λ _. res in
                                           if (τ  (δ self))  f_υ x τ
                                           then (τ  PRE self x) 
                                                (τ  POST self x res)
                                           else τ  res  invalid)"
   assumes all_post': " σ σ' σ''. ((σ,σ')  PRE self x) = ((σ,σ'')  PRE self x)"
           (* PRE is really a pre-condition semantically,
              i.e. it does not depend on the post-state. ... *)
   assumes cpPRE': "PRE (self) x τ = PRE (λ _. self τ) (f_lam x τ) τ "
           (* this interface is preferable than :
              assumes "cp self' ⟹ cp a1' ⟹ cp a2' ⟹ cp (λX. PRE (self' X) (a1' X) (a2' X) )"
              which is too polymorphic. *)
   assumes cpPOST':"POST (self) x (res) τ = POST (λ _. self τ) (f_lam x τ) (λ _. res τ) τ"
   assumes f_υ_val: "a1. f_υ (f_lam a1 τ) τ = f_υ a1 τ"
begin  
   lemma strict0 [simp]: "f invalid X = invalid"
   by(rule ext, rename_tac "τ", simp add: def_scheme' StrongEq_def OclValid_def false_def true_def)

   lemma nullstrict0[simp]: "f null X = invalid"
   by(rule ext, rename_tac "τ", simp add: def_scheme' StrongEq_def OclValid_def false_def true_def)
    
   lemma cp0 : "f self a1 τ = f (λ _. self τ) (f_lam a1 τ) τ"
   proof -
      have A: "(τ  δ (λ_. self τ)) = (τ  δ self)" by(simp add: OclValid_def cp_defined[symmetric])
      have B: "f_υ (f_lam a1 τ) τ = f_υ a1 τ" by (rule f_υ_val)
      have D: "(τ  PRE (λ_. self τ) (f_lam a1 τ)) = ( τ  PRE self a1 )"
                                                 by(simp add: OclValid_def cpPRE'[symmetric])
      show ?thesis
        apply(auto simp: def_scheme' A B D)
        apply(simp add: OclValid_def)
        by(subst cpPOST', simp)
      qed

   theorem unfold' : 
      assumes context_ok:    "cp E"
      and args_def_or_valid: "(τ  δ self)  f_υ a1 τ"
      and pre_satisfied:     "τ  PRE self a1"
      and post_satisfiable:  " res. (τ  POST self a1 (λ _. res))"
      and sat_for_sols_post: "(res. τ  POST self a1 (λ _. res)   τ  E (λ _. res))"
      shows                  "τ  E(f self a1)"
   proof -  
      have cp0: " X τ. E X τ = E (λ_. X τ) τ" by(insert context_ok[simplified cp_def], auto)
      show ?thesis
         apply(simp add: OclValid_def, subst cp0, fold OclValid_def)
         apply(simp add:def_scheme' args_def_or_valid pre_satisfied)
         apply(insert post_satisfiable, elim exE)
         apply(rule Hilbert_Choice.someI2, assumption)
         by(rule sat_for_sols_post, simp)
   qed
   
   lemma unfold2' :
      assumes context_ok:      "cp E"
      and args_def_or_valid:   "(τ  δ self)  (f_υ a1 τ)"
      and pre_satisfied:       "τ  PRE self a1"
      and postsplit_satisfied: "τ  POST' self a1" (* split constraint holds on post-state *)
      and post_decomposable  : " res. (POST self a1 res) = 
                                       ((POST' self a1)  and (res  (BODY self a1)))"
      shows "(τ  E(f self a1)) = (τ  E(BODY self a1))"
   proof -
      have cp0: " X τ. E X τ = E (λ_. X τ) τ" by(insert context_ok[simplified cp_def], auto)
      show ?thesis
         apply(simp add: OclValid_def, subst cp0, fold OclValid_def)      
         apply(simp add:def_scheme' args_def_or_valid pre_satisfied 
                        post_decomposable postsplit_satisfied foundation10')
         apply(subst some_equality)
         apply(simp add: OclValid_def StrongEq_def true_def)+
         by(subst (2) cp0, rule refl)
   qed
end


locale contract0 =
   fixes f   :: "('𝔄,'α0::null)val             
                  ('𝔄,'res::null)val"
   fixes PRE
   fixes POST
   assumes def_scheme: "f self   (λ τ. SOME res. let res = λ _. res in
                                        if (τ  (δ self))
                                        then (τ  PRE self) 
                                             (τ  POST self res)
                                        else τ  res  invalid)"
   assumes all_post: " σ σ' σ''. ((σ,σ')  PRE self) = ((σ,σ'')  PRE self)"
           (* PRE is really a pre-condition semantically,
              i.e. it does not depend on the post-state. ... *)
   assumes cpPRE: "PRE (self)  τ = PRE (λ _. self τ) τ "
           (* this interface is preferable than :
              assumes "cp self' ⟹ cp a1' ⟹ cp a2' ⟹ cp (λX. PRE (self' X) (a1' X) (a2' X) )"
              which is too polymorphic. *)
   assumes cpPOST:"POST (self) (res) τ = POST (λ _. self τ) (λ _. res τ) τ"

sublocale contract0 < contract_scheme "λ_ _. True" "λx _. x" "λx _. f x" "λx _. PRE x" "λx _. POST x"
 apply(unfold_locales)
     apply(simp add: def_scheme, rule all_post, rule cpPRE, rule cpPOST)
by simp

context contract0
begin
   lemma cp_pre: "cp self'   cp (λX. PRE (self' X)  )"
   by(rule_tac f=PRE in cpI1, auto intro: cpPRE)
  
   lemma cp_post: "cp self'  cp res'   cp (λX. POST (self' X) (res' X))"
   by(rule_tac f=POST in cpI2, auto intro: cpPOST)  

   lemma cp [simp]:  "cp self'   cp res'  cp (λX. f (self' X) )"
      by(rule_tac f=f in cpI1, auto intro:cp0)  

   lemmas unfold = unfold'[simplified]

   lemma unfold2 :
      assumes                  "cp E"
      and                      "(τ  δ self)"
      and                      "τ  PRE self"
      and                      "τ  POST' self" (* split constraint holds on post-state *)
      and                      " res. (POST self res) = 
                                       ((POST' self)  and (res  (BODY self)))"
      shows "(τ  E(f self)) = (τ  E(BODY self))"
        apply(rule unfold2'[simplified])
      by((rule assms)+)

end

locale contract1 =
   fixes f   :: "('𝔄,'α0::null)val             
                  ('𝔄,'α1::null)val  
                  ('𝔄,'res::null)val"
   fixes PRE
   fixes POST 
   assumes def_scheme: "f self a1  
                               (λ τ. SOME res. let res = λ _. res in
                                     if (τ  (δ self))   (τ  υ a1)
                                     then (τ  PRE self a1) 
                                          (τ  POST self a1 res)
                                     else τ  res  invalid) "
   assumes all_post: " σ σ' σ''.  ((σ,σ')  PRE self a1) = ((σ,σ'')  PRE self a1)"
           (* PRE is really a pre-condition semantically,
              i.e. it does not depend on the post-state. ... *)
   assumes cpPRE: "PRE (self) (a1)  τ = PRE (λ _. self τ) (λ _. a1 τ) τ "
           (* this interface is preferable than :
              assumes "cp self' ⟹ cp a1' ⟹ cp a2' ⟹ cp (λX. PRE (self' X) (a1' X) (a2' X) )"
              which is too polymorphic. *)
   assumes cpPOST:"POST (self) (a1) (res) τ = POST (λ _. self τ)(λ _. a1 τ) (λ _. res τ) τ"

sublocale contract1 < contract_scheme "λa1 τ. (τ  υ a1)" "λa1 τ. (λ _. a1 τ)"
 apply(unfold_locales)
     apply(rule def_scheme, rule all_post, rule cpPRE, rule cpPOST)
by(simp add: OclValid_def cp_valid[symmetric])

context contract1
begin
   lemma strict1[simp]: "f self invalid = invalid"
   by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)

   lemma defined_mono : "τ υ(f Y Z)  (τ δ Y)  (τ υ Z)"
   by(auto simp: valid_def bot_fun_def invalid_def 
                 def_scheme StrongEq_def OclValid_def false_def true_def
           split: if_split_asm)
   
   lemma cp_pre: "cp self'  cp a1'   cp (λX. PRE (self' X) (a1' X)  )"
   by(rule_tac f=PRE in cpI2, auto intro: cpPRE)
     
   lemma cp_post: "cp self'  cp a1'  cp res'
                    cp (λX. POST (self' X) (a1' X) (res' X))"
   by(rule_tac f=POST in cpI3, auto intro: cpPOST)  
      
   lemma cp [simp]:  "cp self'  cp a1'   cp res'  cp (λX. f (self' X) (a1' X))"
      by(rule_tac f=f in cpI2, auto intro:cp0)  

   lemmas unfold = unfold'
   lemmas unfold2 = unfold2'
end

locale contract2 =
   fixes f   :: "('𝔄,'α0::null)val             
                  ('𝔄,'α1::null)val  ('𝔄,'α2::null)val 
                  ('𝔄,'res::null)val"
   fixes PRE 
   fixes POST 
   assumes def_scheme: "f self a1 a2  
                               (λ τ. SOME res. let res = λ _. res in
                                     if (τ  (δ self))   (τ  υ a1)   (τ  υ a2)
                                     then (τ  PRE self a1 a2) 
                                          (τ  POST self a1 a2 res)
                                     else τ  res  invalid) "
   assumes all_post: " σ σ' σ''.  ((σ,σ')  PRE self a1 a2) = ((σ,σ'')  PRE self a1 a2)"
           (* PRE is really a pre-condition semantically,
              i.e. it does not depend on the post-state. ... *)
   assumes cpPRE: "PRE (self) (a1) (a2) τ = PRE (λ _. self τ) (λ _. a1 τ) (λ _. a2 τ) τ "
           (* this interface is preferable than :
              assumes "cp self' ⟹ cp a1' ⟹ cp a2' ⟹ cp (λX. PRE (self' X) (a1' X) (a2' X) )"
              which is too polymorphic. *)
   assumes cpPOST:"res. POST (self) (a1) (a2) (res) τ = 
                         POST (λ _. self τ)(λ _. a1 τ)(λ _. a2 τ) (λ _. res τ) τ"


sublocale contract2 < contract_scheme "λ(a1,a2) τ. (τ  υ a1)  (τ  υ a2)" 
                                      "λ(a1,a2) τ. (λ _.a1 τ, λ _.a2 τ)"
                                      "(λx (a,b). f x a b)"
                                      "(λx (a,b). PRE x a b)"
                                      "(λx (a,b). POST x a b)"
 apply(unfold_locales)
     apply(auto simp add: def_scheme)
        apply (metis all_post, metis all_post)
      apply(subst cpPRE, simp)
     apply(subst cpPOST, simp)
by(simp_all add: OclValid_def cp_valid[symmetric])

context contract2
begin
   lemma strict0'[simp] : "f invalid X Y = invalid"
   by(insert strict0[of "(X,Y)"], simp)

   lemma nullstrict0'[simp]: "f null X Y = invalid"
   by(insert nullstrict0[of "(X,Y)"], simp)

   lemma strict1[simp]: "f self invalid Y = invalid"
   by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)

   lemma strict2[simp]: "f self X invalid = invalid"
   by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
   
   lemma defined_mono : "τ υ(f X Y Z)  (τ δ X)  (τ υ Y)  (τ υ Z)"
   by(auto simp: valid_def bot_fun_def invalid_def 
                 def_scheme StrongEq_def OclValid_def false_def true_def
           split: if_split_asm)
   
   lemma cp_pre: "cp self'  cp a1'  cp a2'  cp (λX. PRE (self' X) (a1' X) (a2' X) )"
   by(rule_tac f=PRE in cpI3, auto intro: cpPRE)
  
   lemma cp_post: "cp self'  cp a1'  cp a2'  cp res'
                    cp (λX. POST (self' X) (a1' X) (a2' X) (res' X))"
   by(rule_tac f=POST in cpI4, auto intro: cpPOST)  
   
   lemma cp0' : "f self a1 a2 τ = f (λ _. self τ) (λ _. a1 τ) (λ _. a2 τ) τ"
   by (rule cp0[of _ "(a1,a2)", simplified])
      
   lemma cp [simp]:  "cp self'  cp a1'  cp a2'  cp res'
                        cp (λX. f (self' X) (a1' X) (a2' X))"
      by(rule_tac f=f in cpI3, auto intro:cp0')  

   theorem unfold : 
      assumes                "cp E"
      and                    "(τ  δ self)  (τ  υ a1)   (τ  υ a2)"
      and                    "τ  PRE self a1 a2"
      and                    " res. (τ  POST self a1 a2 (λ _. res))"
      and                    "(res. τ  POST self a1 a2 (λ _. res)   τ  E (λ _. res))"
      shows                  "τ  E(f self a1 a2)"
      apply(rule unfold'[of _ _ _ "(a1, a2)", simplified])
      by((rule assms)+)

   lemma unfold2 :
      assumes                  "cp E"
      and                      "(τ  δ self)  (τ  υ a1)   (τ  υ a2)"
      and                      "τ  PRE self a1 a2"
      and                      "τ  POST' self a1 a2" (* split constraint holds on post-state *)
      and                      " res. (POST self a1 a2 res) = 
                                       ((POST' self a1 a2)  and (res  (BODY self a1 a2)))"
      shows "(τ  E(f self a1 a2)) = (τ  E(BODY self a1 a2))"
      apply(rule unfold2'[of _ _ _ "(a1, a2)", simplified])
      by((rule assms)+)
end

locale contract3 =
   fixes f   :: "('𝔄,'α0::null)val             
                  ('𝔄,'α1::null)val  
                  ('𝔄,'α2::null)val 
                  ('𝔄,'α3::null)val 
                  ('𝔄,'res::null)val"
   fixes PRE 
   fixes POST 
   assumes def_scheme: "f self a1 a2 a3  
                               (λ τ. SOME res. let res = λ _. res in
                                     if (τ  (δ self))   (τ  υ a1)   (τ  υ a2)   (τ  υ a3)
                                     then (τ  PRE self a1 a2 a3) 
                                          (τ  POST self a1 a2 a3 res)
                                     else τ  res  invalid) "
   assumes all_post: " σ σ' σ''.  ((σ,σ')  PRE self a1 a2 a3) = ((σ,σ'')  PRE self a1 a2 a3)"
           (* PRE is really a pre-condition semantically,
              i.e. it does not depend on the post-state. ... *)
   assumes cpPRE: "PRE (self) (a1) (a2) (a3) τ = PRE (λ _. self τ) (λ _. a1 τ) (λ _. a2 τ) (λ _. a3 τ) τ "
           (* this interface is preferable than :
              assumes "cp self' ⟹ cp a1' ⟹ cp a2' ⟹ cp a3' ⟹ cp (λX. PRE (self' X) (a1' X) (a2' X) (a3' X) )"
              which is too polymorphic. *)
   assumes cpPOST:"res. POST (self) (a1) (a2) (a3) (res) τ = 
                         POST (λ _. self τ)(λ _. a1 τ)(λ _. a2 τ)(λ _. a3 τ) (λ _. res τ) τ"


sublocale contract3 < contract_scheme "λ(a1,a2,a3) τ. (τ  υ a1)  (τ  υ a2) (τ  υ a3)" 
                                      "λ(a1,a2,a3) τ. (λ _.a1 τ, λ _.a2 τ, λ _.a3 τ)"
                                      "(λx (a,b,c). f x a b c)"
                                      "(λx (a,b,c). PRE x a b c)"
                                      "(λx (a,b,c). POST x a b c)"
 apply(unfold_locales)
     apply(auto simp add: def_scheme)
        apply (metis all_post, metis all_post)
      apply(subst cpPRE, simp)
     apply(subst cpPOST, simp)
by(simp_all add: OclValid_def cp_valid[symmetric])

context contract3
begin
   lemma strict0'[simp] : "f invalid X Y Z = invalid"
   by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)

   lemma nullstrict0'[simp]: "f null X Y Z = invalid"
   by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)

   lemma strict1[simp]: "f self invalid Y Z = invalid"
   by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)

   lemma strict2[simp]: "f self X invalid Z = invalid"
   by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)

   lemma defined_mono : "τ υ(f W X Y Z)  (τ δ W)  (τ υ X)  (τ υ Y)  (τ υ Z)"
   by(auto simp: valid_def bot_fun_def invalid_def 
                 def_scheme StrongEq_def OclValid_def false_def true_def
           split: if_split_asm)
   
   lemma cp_pre: "cp self'  cp a1'  cp a2' cp a3' 
                   cp (λX. PRE (self' X) (a1' X) (a2' X) (a3' X) )"
   by(rule_tac f=PRE in cpI4, auto intro: cpPRE)
  
   lemma cp_post: "cp self'  cp a1'  cp a2'  cp a3'  cp res'
                    cp (λX. POST (self' X) (a1' X) (a2' X) (a3' X)  (res' X))"
   by(rule_tac f=POST in cpI5, auto intro: cpPOST)  
   
   lemma cp0' : "f self a1 a2 a3 τ = f (λ _. self τ) (λ _. a1 τ) (λ _. a2 τ) (λ _. a3 τ) τ"
   by (rule cp0[of _ "(a1,a2,a3)", simplified])
      
   lemma cp [simp]:  "cp self'  cp a1'  cp a2'  cp a3'  cp res'
                        cp (λX. f (self' X) (a1' X) (a2' X) (a3' X))"
      by(rule_tac f=f in cpI4, auto intro:cp0')  

   theorem unfold : 
      assumes                "cp E"
      and                    "(τ  δ self)  (τ  υ a1)   (τ  υ a2)   (τ  υ a3)"
      and                    "τ  PRE self a1 a2 a3"
      and                    " res. (τ  POST self a1 a2 a3 (λ _. res))"
      and                    "(res. τ  POST self a1 a2 a3 (λ _. res)   τ  E (λ _. res))"
      shows                  "τ  E(f self a1 a2 a3)"
      apply(rule unfold'[of _ _ _ "(a1, a2, a3)", simplified])
      by((rule assms)+)

   lemma unfold2 :
      assumes                  "cp E"
      and                      "(τ  δ self)  (τ  υ a1)   (τ  υ a2)   (τ  υ a3)"
      and                      "τ  PRE self a1 a2 a3"
      and                      "τ  POST' self a1 a2 a3" (* split constraint holds on post-state *)
      and                      " res. (POST self a1 a2 a3 res) = 
                                       ((POST' self a1 a2 a3)  and (res  (BODY self a1 a2 a3)))"
      shows "(τ  E(f self a1 a2 a3)) = (τ  E(BODY self a1 a2 a3))"
      apply(rule unfold2'[of _ _ _ "(a1, a2, a3)", simplified])
      by((rule assms)+)
end


end

Theory UML_Tools

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5 
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Tools.thy ---
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

(* < *)
theory UML_Tools
imports UML_Logic
begin


lemmas substs1 = StrongEq_L_subst2_rev
                 foundation15[THEN iffD2, THEN StrongEq_L_subst2_rev]
                 foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, 
                                       THEN StrongEq_L_subst2_rev]]                
                 foundation14[THEN iffD2, THEN StrongEq_L_subst2_rev]
                 foundation13[THEN iffD2, THEN StrongEq_L_subst2_rev]
                
lemmas substs2 = StrongEq_L_subst3_rev
                 foundation15[THEN iffD2, THEN StrongEq_L_subst3_rev]
                 foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, 
                                       THEN StrongEq_L_subst3_rev]]                
                 foundation14[THEN iffD2, THEN StrongEq_L_subst3_rev]
                 foundation13[THEN iffD2, THEN StrongEq_L_subst3_rev]
                 
lemmas substs4 = StrongEq_L_subst4_rev
                 foundation15[THEN iffD2, THEN StrongEq_L_subst4_rev]
                 foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, 
                                       THEN StrongEq_L_subst4_rev]]                
                 foundation14[THEN iffD2, THEN StrongEq_L_subst4_rev]
                 foundation13[THEN iffD2, THEN StrongEq_L_subst4_rev]

                 
lemmas substs = substs1 substs2 substs4 [THEN iffD2] substs4
thm substs
MLfun ocl_subst_asm_tac ctxt  = FIRST'(map (fn C => (eresolve0_tac [C]) THEN' (simp_tac ctxt)) 
                                         @{thms "substs"})

val ocl_subst_asm = fn ctxt => SIMPLE_METHOD (ocl_subst_asm_tac ctxt 1); 

val _ = Theory.setup 
             (Method.setup (Binding.name "ocl_subst_asm") 
             (Scan.succeed (ocl_subst_asm)) 
             "ocl substition step")

lemma test1 : "τ  A  τ  (A and B  B)"
apply(tactic "ocl_subst_asm_tac @{context} 1")
apply(simp)
done

lemma test2 : "τ  A  τ  (A and B  B)"
by(ocl_subst_asm, simp)

lemma test3 : "τ  A  τ  (A and A)"
by(ocl_subst_asm, simp)

lemma test4 : "τ  not A  τ  (A and B  false)"
by(ocl_subst_asm, simp)

lemma test5 : "τ  (A  null)  τ  (B  null)  ¬ (τ  (A and B))"
by(ocl_subst_asm,ocl_subst_asm,simp)

lemma test6 : "τ  not A  ¬ (τ  (A and B))"
by(ocl_subst_asm, simp)

lemma test7 : "¬ (τ  (υ A))  τ  (not B)  ¬ (τ  (A and B))"
by(ocl_subst_asm,ocl_subst_asm,simp)

                  
    


(* a proof that shows that not everything is humpty dumpty ... *)
lemma X: "¬ (τ  (invalid and B))"
apply(insert foundation8[of "τ" "B"], elim disjE, 
      simp add:defined_bool_split, elim disjE)
apply(ocl_subst_asm, simp)
apply(ocl_subst_asm, simp)
apply(ocl_subst_asm, simp)
apply(ocl_subst_asm, simp)
done

(* easier is: *)
(* just to show the power of this extremely useful foundational rule:*)
lemma X': "¬ (τ  (invalid and B))"
by(simp add:foundation10')
lemma Y: "¬ (τ  (null and B))"
by(simp add: foundation10')
lemma Z: "¬ (τ  (false and B))"
by(simp add: foundation10')
lemma Z': "(τ  (true and B)) = (τ  B)"
by(simp)

 
end

(* > *)

Theory UML_Main

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5 
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_Main.thy --- 
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

theory UML_Main
imports UML_Contracts UML_Tools
begin
end

Theory Analysis_UML

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * Analysis_UML.thy --- OCL Contracts and an Example.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

chapter‹Example: The Employee Analysis Model› (* UML part *)

theory
  Analysis_UML
imports
  "../../../UML_Main"
begin

text ‹\label{ex:employee-analysis:uml}›

section‹Introduction›
text‹
  For certain concepts like classes and class-types, only a generic
  definition for its resulting semantics can be given. Generic means,
  there is a function outside HOL that ``compiles'' a concrete,
  closed-world class diagram into a ``theory'' of this data model,
  consisting of a bunch of definitions for classes, accessors, method,
  casts, and tests for actual types, as well as proofs for the
  fundamental properties of these operations in this concrete data
  model.›

text‹Such generic function or ``compiler'' can be implemented in
  Isabelle on the ML level.  This has been done, for a semantics
  following the open-world assumption, for UML 2.0
  in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In
  this paper, we follow another approach for UML 2.4: we define the
  concepts of the compilation informally, and present a concrete
  example which is verified in Isabelle/HOL.›

subsection‹Outlining the Example›

text‹We are presenting here an ``analysis-model'' of the (slightly
modified) example Figure 7.3, page 20 of
the OCL standard~\cite{omg:ocl:2012}.
Here, analysis model means that associations
were really represented as relation on objects on the state---as is
intended by the standard---rather by pointers between objects as is
done in our ``design model'' 
\isatagafp
(see \autoref{ex:employee-design:uml}).
\endisatagafp
\isatagannexa
(see \url{http://isa-afp.org/entries/Featherweight_OCL.shtml}).
\endisatagannexa
To be precise, this theory contains the formalization of the data-part
covered by the UML class model (see \autoref{fig:person-ana}):›

text‹
\begin{figure}
  \centering\scalebox{.3}{\includegraphics{figures/person.png}}%
  \caption{A simple UML class model drawn from Figure 7.3,
  page 20 of~\cite{omg:ocl:2012}. \label{fig:person-ana}}
\end{figure}
›

text‹This means that the association (attached to the association class
\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented
by the attribute  \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the OCL part
captured by the subsequent theory).
›

section‹Example Data-Universe and its Infrastructure›
text‹Ideally, the following is generated automatically from a UML class model.›

text‹Our data universe  consists in the concrete class diagram just of node's,
and implicitly of the class object. Each class implies the existence of a class
type defined for the corresponding object representations as follows:›

datatype typePerson = mkPerson oid          (* the oid to the person itself *)
                            "int option" (* the attribute "salary" or null *)


datatype typeOclAny = mkOclAny oid          (* the oid to the oclany itself *)
                            "(int option) option"
                                         (* the extensions to "person"; used to denote
                                            objects of actual type "person" casted to "oclany";
                                            in case of existence of several subclasses
                                            of oclany, sums of extensions have to be provided. *)

text‹Now, we construct a concrete ``universe of OclAny types'' by injection into a
sum type containing the class types. This type of OclAny will be used as instance
for all respective type-variables.›

datatype 𝔄 = inPerson typePerson | inOclAny typeOclAny

text‹Having fixed the object universe, we can introduce type synonyms that exactly correspond
to OCL types. Again, we exploit that our representation of OCL is a ``shallow embedding'' with a
one-to-one correspondance of OCL-types to types of the meta-language HOL.›
type_synonym Boolean     = " 𝔄 Boolean"
type_synonym Integer     = " 𝔄 Integer"
type_synonym Void        = " 𝔄 Void"
type_synonym OclAny      = "(𝔄, typeOclAny option option) val"
type_synonym Person      = "(𝔄, typePerson option option) val"
type_synonym Set_Integer = "(𝔄, int option option) Set"
type_synonym Set_Person  = "(𝔄, typePerson option option) Set"

text‹Just a little check:›
typ "Boolean"

text‹To reuse key-elements of the library like referential equality, we have
to show that the object universe belongs to the type class ``oclany,'' \ie,
 each class type has to provide a function @{term oid_of} yielding the object id (oid) of the object.›
instantiation typePerson :: object
begin
   definition oid_of_typePerson_def: "oid_of x = (case x of mkPerson oid _  oid)"
   instance ..
end

instantiation typeOclAny :: object
begin
   definition oid_of_typeOclAny_def: "oid_of x = (case x of mkOclAny oid _  oid)"
   instance ..
end

instantiation 𝔄 :: object
begin
   definition oid_of_𝔄_def: "oid_of x = (case x of
                                             inPerson person  oid_of person
                                           | inOclAny oclany  oid_of oclany)"
   instance ..
end




section‹Instantiation of the Generic Strict Equality›
text‹We instantiate the referential equality
on Person› and OclAny›

overloading StrictRefEq  "StrictRefEq :: [Person,Person]  Boolean"
begin
  definition StrictRefEqObject_Person   : "(x::Person)  y   StrictRefEqObject x y"
end

overloading StrictRefEq  "StrictRefEq :: [OclAny,OclAny]  Boolean"
begin
  definition StrictRefEqObject_OclAny   : "(x::OclAny)  y   StrictRefEqObject x y"
end

lemmas cps23 = 
    cp_StrictRefEqObject[of "x::Person" "y::Person" "τ",
                         simplified StrictRefEqObject_Person[symmetric]]
    cp_intro(9)         [of "P::Person Person""Q::Person Person",
                         simplified StrictRefEqObject_Person[symmetric] ]
    StrictRefEqObject_def      [of "x::Person" "y::Person",
                         simplified StrictRefEqObject_Person[symmetric]]
    StrictRefEqObject_defargs  [of _ "x::Person" "y::Person",
                         simplified StrictRefEqObject_Person[symmetric]]
    StrictRefEqObject_strict1
                        [of "x::Person",
                         simplified StrictRefEqObject_Person[symmetric]]
    StrictRefEqObject_strict2
                        [of "x::Person",
                         simplified StrictRefEqObject_Person[symmetric]]
  for x y τ P Q
text‹For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)},
   a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form
   \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator.
›
text‹Thus, since we have two class-types in our concrete class hierarchy, we have
two operations to declare and to provide two overloading definitions for the two static types.
›


section‹OclAsType›
subsection‹Definition›

consts OclAsTypeOclAny :: "  OclAny" ("(_) .oclAsType'(OclAny')")
consts OclAsTypePerson :: "  Person" ("(_) .oclAsType'(Person')")

definition "OclAsTypeOclAny_𝔄 = (λu. case u of inOclAny a  a
                                             | inPerson (mkPerson oid a)  mkOclAny oid a)"

lemma OclAsTypeOclAny_𝔄_some: "OclAsTypeOclAny_𝔄 x  None"
by(simp add: OclAsTypeOclAny_𝔄_def)

overloading OclAsTypeOclAny  "OclAsTypeOclAny :: OclAny  OclAny"
begin
  definition OclAsTypeOclAny_OclAny:
        "(X::OclAny) .oclAsType(OclAny)  X"
end

overloading OclAsTypeOclAny  "OclAsTypeOclAny :: Person  OclAny"
begin
  definition OclAsTypeOclAny_Person:
        "(X::Person) .oclAsType(OclAny) 
                   (λτ. case X τ of
                                  invalid τ
                            |   null τ
                            | mkPerson oid a      (mkOclAny oid a) )"
end

definition "OclAsTypePerson_𝔄 = 
                   (λu. case u of inPerson p  p
                            | inOclAny (mkOclAny oid a)  mkPerson oid a
                            | _  None)"

overloading OclAsTypePerson  "OclAsTypePerson :: OclAny  Person"
begin
  definition OclAsTypePerson_OclAny:
        "(X::OclAny) .oclAsType(Person) 
                   (λτ. case X τ of
                                  invalid τ
                            |   null τ
                            | mkOclAny oid     invalid τ   ― ‹down-cast exception›
                            | mkOclAny oid a    mkPerson oid a)"
end

overloading OclAsTypePerson  "OclAsTypePerson :: Person  Person"
begin
  definition OclAsTypePerson_Person:
        "(X::Person) .oclAsType(Person)  X "  (* to avoid identity for null ? *)
end

text_raw‹\isatagafp›

lemmas [simp] =
 OclAsTypeOclAny_OclAny
 OclAsTypePerson_Person
subsection‹Context Passing›

lemma cp_OclAsTypeOclAny_Person_Person: "cp P  cp(λX. (P (X::Person)::Person) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsTypeOclAny_Person)
lemma cp_OclAsTypeOclAny_OclAny_OclAny: "cp P  cp(λX. (P (X::OclAny)::OclAny) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsTypeOclAny_OclAny)
lemma cp_OclAsTypePerson_Person_Person: "cp P  cp(λX. (P (X::Person)::Person) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsTypePerson_Person)
lemma cp_OclAsTypePerson_OclAny_OclAny: "cp P  cp(λX. (P (X::OclAny)::OclAny) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsTypePerson_OclAny)

lemma cp_OclAsTypeOclAny_Person_OclAny: "cp P  cp(λX. (P (X::Person)::OclAny) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsTypeOclAny_OclAny)
lemma cp_OclAsTypeOclAny_OclAny_Person: "cp P  cp(λX. (P (X::OclAny)::Person) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsTypeOclAny_Person)
lemma cp_OclAsTypePerson_Person_OclAny: "cp P  cp(λX. (P (X::Person)::OclAny) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsTypePerson_OclAny)
lemma cp_OclAsTypePerson_OclAny_Person: "cp P  cp(λX. (P (X::OclAny)::Person) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsTypePerson_Person)

lemmas [simp] =
 cp_OclAsTypeOclAny_Person_Person
 cp_OclAsTypeOclAny_OclAny_OclAny
 cp_OclAsTypePerson_Person_Person
 cp_OclAsTypePerson_OclAny_OclAny

 cp_OclAsTypeOclAny_Person_OclAny
 cp_OclAsTypeOclAny_OclAny_Person
 cp_OclAsTypePerson_Person_OclAny
 cp_OclAsTypePerson_OclAny_Person

text_raw‹\endisatagafp›

subsection‹Execution with Invalid or Null as Argument›

lemma OclAsTypeOclAny_OclAny_strict : "(invalid::OclAny) .oclAsType(OclAny) = invalid" by(simp)
lemma OclAsTypeOclAny_OclAny_nullstrict : "(null::OclAny) .oclAsType(OclAny) = null" by(simp)
lemma OclAsTypeOclAny_Person_strict[simp] : "(invalid::Person) .oclAsType(OclAny) = invalid"
      by(rule ext, simp add: bot_option_def invalid_def OclAsTypeOclAny_Person)
lemma OclAsTypeOclAny_Person_nullstrict[simp] : "(null::Person) .oclAsType(OclAny) = null"
      by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsTypeOclAny_Person)
lemma OclAsTypePerson_OclAny_strict[simp] : "(invalid::OclAny) .oclAsType(Person) = invalid"
      by(rule ext, simp add: bot_option_def invalid_def  OclAsTypePerson_OclAny)
lemma OclAsTypePerson_OclAny_nullstrict[simp] : "(null::OclAny) .oclAsType(Person) = null"
      by(rule ext, simp add: null_fun_def null_option_def bot_option_def  OclAsTypePerson_OclAny)
lemma OclAsTypePerson_Person_strict : "(invalid::Person) .oclAsType(Person) = invalid"  by(simp)
lemma OclAsTypePerson_Person_nullstrict : "(null::Person) .oclAsType(Person) = null" by(simp)

section‹OclIsTypeOf›

subsection‹Definition›

consts OclIsTypeOfOclAny :: "  Boolean" ("(_).oclIsTypeOf'(OclAny')")
consts OclIsTypeOfPerson :: "  Boolean" ("(_).oclIsTypeOf'(Person')")

overloading OclIsTypeOfOclAny  "OclIsTypeOfOclAny :: OclAny  Boolean"
begin
  definition OclIsTypeOfOclAny_OclAny:
        "(X::OclAny) .oclIsTypeOf(OclAny) 
                   (λτ. case X τ of
                                  invalid τ
                            |   true τ  ― ‹invalid ??›
                            | mkOclAny oid    true τ
                            | mkOclAny oid _   false τ)"
end

lemma OclIsTypeOfOclAny_OclAny':
         "(X::OclAny) .oclIsTypeOf(OclAny) = 
                    (λ τ. if τ  υ X then (case X τ of
                                                true τ  ― ‹invalid ??›
                                           | mkOclAny oid    true τ
                                           | mkOclAny oid _   false τ)
                                           else invalid τ)"
       apply(rule ext, simp add: OclIsTypeOfOclAny_OclAny)
       by(case_tac "τ  υ X", auto simp: foundation18' bot_option_def)

interpretation OclIsTypeOfOclAny_OclAny : 
       profile_mono_schemeV 
       "OclIsTypeOfOclAny::OclAny  Boolean" 
       "λ X. (case X of
                    None  True  ― ‹invalid ??›
                  | mkOclAny oid None   True
                  | mkOclAny oid _   False)"                     
      apply(unfold_locales, simp add: atomize_eq, rule ext)
      by(auto simp:  OclIsTypeOfOclAny_OclAny' OclValid_def true_def false_def 
              split: option.split typeOclAny.split)

overloading OclIsTypeOfOclAny  "OclIsTypeOfOclAny :: Person  Boolean"
begin
  definition OclIsTypeOfOclAny_Person:
        "(X::Person) .oclIsTypeOf(OclAny) 
                   (λτ. case X τ of
                                  invalid τ
                            |   true τ    ― ‹invalid ??›
                            |  _   false τ)  ― ‹must have actual type Person› otherwise›"
end

overloading OclIsTypeOfPerson  "OclIsTypeOfPerson :: OclAny  Boolean"
begin
  definition OclIsTypeOfPerson_OclAny:
        "(X::OclAny) .oclIsTypeOf(Person) 
                   (λτ. case X τ of
                                  invalid τ
                            |   true τ
                            | mkOclAny oid    false τ
                            | mkOclAny oid _   true τ)"
end

overloading OclIsTypeOfPerson  "OclIsTypeOfPerson :: Person  Boolean"
begin
  definition OclIsTypeOfPerson_Person:
        "(X::Person) .oclIsTypeOf(Person) 
                   (λτ. case X τ of
                                invalid τ
                            | _  true τ)" (* for (* ⌊⌊ _ ⌋⌋ ⇒ true τ *) : must have actual type Node otherwise  *)
end
text_raw‹\isatagafp›
subsection‹Context Passing›

lemma cp_OclIsTypeOfOclAny_Person_Person: "cp P  cp(λX.(P(X::Person)::Person).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOfOclAny_Person)
lemma cp_OclIsTypeOfOclAny_OclAny_OclAny: "cp P  cp(λX.(P(X::OclAny)::OclAny).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOfOclAny_OclAny)
lemma cp_OclIsTypeOfPerson_Person_Person: "cp P  cp(λX.(P(X::Person)::Person).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOfPerson_Person)
lemma cp_OclIsTypeOfPerson_OclAny_OclAny: "cp P  cp(λX.(P(X::OclAny)::OclAny).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOfPerson_OclAny)


lemma cp_OclIsTypeOfOclAny_Person_OclAny: "cp P  cp(λX.(P(X::Person)::OclAny).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOfOclAny_OclAny)
lemma cp_OclIsTypeOfOclAny_OclAny_Person: "cp P  cp(λX.(P(X::OclAny)::Person).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOfOclAny_Person)
lemma cp_OclIsTypeOfPerson_Person_OclAny: "cp P  cp(λX.(P(X::Person)::OclAny).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOfPerson_OclAny)
lemma cp_OclIsTypeOfPerson_OclAny_Person: "cp P  cp(λX.(P(X::OclAny)::Person).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOfPerson_Person)

lemmas [simp] =
 cp_OclIsTypeOfOclAny_Person_Person
 cp_OclIsTypeOfOclAny_OclAny_OclAny
 cp_OclIsTypeOfPerson_Person_Person
 cp_OclIsTypeOfPerson_OclAny_OclAny

 cp_OclIsTypeOfOclAny_Person_OclAny
 cp_OclIsTypeOfOclAny_OclAny_Person
 cp_OclIsTypeOfPerson_Person_OclAny
 cp_OclIsTypeOfPerson_OclAny_Person
text_raw‹\endisatagafp›

subsection‹Execution with Invalid or Null as Argument›

lemma OclIsTypeOfOclAny_OclAny_strict1[simp]:
     "(invalid::OclAny) .oclIsTypeOf(OclAny) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfOclAny_OclAny)
lemma OclIsTypeOfOclAny_OclAny_strict2[simp]:
     "(null::OclAny) .oclIsTypeOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfOclAny_OclAny)
lemma OclIsTypeOfOclAny_Person_strict1[simp]:
     "(invalid::Person) .oclIsTypeOf(OclAny) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfOclAny_Person)
lemma OclIsTypeOfOclAny_Person_strict2[simp]:
     "(null::Person) .oclIsTypeOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfOclAny_Person)
lemma OclIsTypeOfPerson_OclAny_strict1[simp]:
     "(invalid::OclAny) .oclIsTypeOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfPerson_OclAny)
lemma OclIsTypeOfPerson_OclAny_strict2[simp]:
     "(null::OclAny) .oclIsTypeOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfPerson_OclAny)
lemma OclIsTypeOfPerson_Person_strict1[simp]:
     "(invalid::Person) .oclIsTypeOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfPerson_Person)
lemma OclIsTypeOfPerson_Person_strict2[simp]:
     "(null::Person) .oclIsTypeOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfPerson_Person)

subsection‹Up Down Casting›

lemma actualType_larger_staticType:
assumes isdef: "τ  (δ X)"
shows          "τ  (X::Person) .oclIsTypeOf(OclAny)  false"
using isdef
by(auto simp : null_option_def bot_option_def
               OclIsTypeOfOclAny_Person foundation22 foundation16)

lemma down_cast_type:
assumes isOclAny: "τ  (X::OclAny) .oclIsTypeOf(OclAny)"
and     non_null: "τ  (δ X)"
shows             "τ  (X .oclAsType(Person))  invalid"
using isOclAny non_null
apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
                  OclAsTypeOclAny_Person OclAsTypePerson_OclAny foundation22 foundation16
           split: option.split typeOclAny.split typePerson.split)
by(simp add: OclIsTypeOfOclAny_OclAny  OclValid_def false_def true_def)

lemma down_cast_type':
assumes isOclAny: "τ  (X::OclAny) .oclIsTypeOf(OclAny)"
and     non_null: "τ  (δ X)"
shows             "τ  not (υ (X .oclAsType(Person)))"
by(rule foundation15[THEN iffD1], simp add: down_cast_type[OF assms])

lemma up_down_cast :
assumes isdef: "τ  (δ X)"
shows "τ  ((X::Person) .oclAsType(OclAny) .oclAsType(Person)  X)"
using isdef
by(auto simp : null_fun_def null_option_def bot_option_def null_def invalid_def
               OclAsTypeOclAny_Person OclAsTypePerson_OclAny foundation22 foundation16
        split: option.split typePerson.split)


lemma up_down_cast_Person_OclAny_Person [simp]:
shows "((X::Person) .oclAsType(OclAny) .oclAsType(Person) = X)"
 apply(rule ext, rename_tac τ)
 apply(rule foundation22[THEN iffD1])
 apply(case_tac "τ  (δ X)", simp add: up_down_cast)
 apply(simp add: defined_split, elim disjE)
 apply(erule StrongEq_L_subst2_rev, simp, simp)+
done

lemma up_down_cast_Person_OclAny_Person':
assumes "τ  υ X"
shows   "τ  (((X :: Person) .oclAsType(OclAny) .oclAsType(Person))  X)"
 apply(simp only: up_down_cast_Person_OclAny_Person StrictRefEqObject_Person)
by(rule StrictRefEqObject_sym, simp add: assms)

lemma up_down_cast_Person_OclAny_Person'': 
assumes "τ  υ (X :: Person)"
shows   "τ  (X .oclIsTypeOf(Person) implies (X .oclAsType(OclAny) .oclAsType(Person))  X)"
 apply(simp add: OclValid_def)
 apply(subst cp_OclImplies)
 apply(simp add: StrictRefEqObject_Person StrictRefEqObject_sym[OF assms, simplified OclValid_def])
 apply(subst cp_OclImplies[symmetric])
by simp


section‹OclIsKindOf›
subsection‹Definition›

consts OclIsKindOfOclAny :: "  Boolean" ("(_).oclIsKindOf'(OclAny')")
consts OclIsKindOfPerson :: "  Boolean" ("(_).oclIsKindOf'(Person')")

overloading OclIsKindOfOclAny  "OclIsKindOfOclAny :: OclAny  Boolean"
begin
  definition OclIsKindOfOclAny_OclAny:
        "(X::OclAny) .oclIsKindOf(OclAny) 
                   (λτ. case X τ of
                                invalid τ
                            | _  true τ)"
end

overloading OclIsKindOfOclAny  "OclIsKindOfOclAny :: Person  Boolean"
begin
  definition OclIsKindOfOclAny_Person:
        "(X::Person) .oclIsKindOf(OclAny) 
                   (λτ. case X τ of
                                invalid τ
                            | _ true τ)"
(* for (* ⌊⌊mkPerson e oid _ ⌋⌋ ⇒ true τ *) :  must have actual type Person otherwise  *)
end

overloading OclIsKindOfPerson  "OclIsKindOfPerson :: OclAny  Boolean"
begin
  definition OclIsKindOfPerson_OclAny:
        "(X::OclAny) .oclIsKindOf(Person) 
                   (λτ. case X τ of
                                  invalid τ
                            |   true τ
                            | mkOclAny oid    false τ
                            | mkOclAny oid _   true τ)"
end

overloading OclIsKindOfPerson  "OclIsKindOfPerson :: Person  Boolean"
begin
  definition OclIsKindOfPerson_Person:
        "(X::Person) .oclIsKindOf(Person) 
                   (λτ. case X τ of
                                invalid τ
                            | _  true τ)"
end
text_raw‹\isatagafp›
subsection‹Context Passing›

lemma cp_OclIsKindOfOclAny_Person_Person: "cp P  cp(λX.(P(X::Person)::Person).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOfOclAny_Person)
lemma cp_OclIsKindOfOclAny_OclAny_OclAny: "cp P  cp(λX.(P(X::OclAny)::OclAny).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOfOclAny_OclAny)
lemma cp_OclIsKindOfPerson_Person_Person: "cp P  cp(λX.(P(X::Person)::Person).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOfPerson_Person)
lemma cp_OclIsKindOfPerson_OclAny_OclAny: "cp P  cp(λX.(P(X::OclAny)::OclAny).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOfPerson_OclAny)

lemma cp_OclIsKindOfOclAny_Person_OclAny: "cp P  cp(λX.(P(X::Person)::OclAny).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOfOclAny_OclAny)
lemma cp_OclIsKindOfOclAny_OclAny_Person: "cp P  cp(λX.(P(X::OclAny)::Person).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOfOclAny_Person)
lemma cp_OclIsKindOfPerson_Person_OclAny: "cp P  cp(λX.(P(X::Person)::OclAny).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOfPerson_OclAny)
lemma cp_OclIsKindOfPerson_OclAny_Person: "cp P  cp(λX.(P(X::OclAny)::Person).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOfPerson_Person)

lemmas [simp] =
 cp_OclIsKindOfOclAny_Person_Person
 cp_OclIsKindOfOclAny_OclAny_OclAny
 cp_OclIsKindOfPerson_Person_Person
 cp_OclIsKindOfPerson_OclAny_OclAny

 cp_OclIsKindOfOclAny_Person_OclAny
 cp_OclIsKindOfOclAny_OclAny_Person
 cp_OclIsKindOfPerson_Person_OclAny
 cp_OclIsKindOfPerson_OclAny_Person
text_raw‹\endisatagafp›
subsection‹Execution with Invalid or Null as Argument›

lemma OclIsKindOfOclAny_OclAny_strict1[simp] : "(invalid::OclAny) .oclIsKindOf(OclAny) = invalid"
by(rule ext, simp add: invalid_def bot_option_def
                       OclIsKindOfOclAny_OclAny)
lemma OclIsKindOfOclAny_OclAny_strict2[simp] : "(null::OclAny) .oclIsKindOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def
                       OclIsKindOfOclAny_OclAny)
lemma OclIsKindOfOclAny_Person_strict1[simp] : "(invalid::Person) .oclIsKindOf(OclAny) = invalid"
by(rule ext, simp add: bot_option_def invalid_def
                       OclIsKindOfOclAny_Person)
lemma OclIsKindOfOclAny_Person_strict2[simp] : "(null::Person) .oclIsKindOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def
                       OclIsKindOfOclAny_Person)
lemma OclIsKindOfPerson_OclAny_strict1[simp]: "(invalid::OclAny) .oclIsKindOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsKindOfPerson_OclAny)
lemma OclIsKindOfPerson_OclAny_strict2[simp]: "(null::OclAny) .oclIsKindOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsKindOfPerson_OclAny)
lemma OclIsKindOfPerson_Person_strict1[simp]: "(invalid::Person) .oclIsKindOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsKindOfPerson_Person)
lemma OclIsKindOfPerson_Person_strict2[simp]: "(null::Person) .oclIsKindOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsKindOfPerson_Person)

subsection‹Up Down Casting›

lemma actualKind_larger_staticKind:
assumes isdef: "τ  (δ X)"
shows          "τ   ((X::Person) .oclIsKindOf(OclAny)  true)"
using isdef
by(auto simp : bot_option_def
               OclIsKindOfOclAny_Person foundation22 foundation16)

lemma down_cast_kind:
assumes isOclAny: "¬ (τ  ((X::OclAny).oclIsKindOf(Person)))"
and     non_null: "τ  (δ X)"
shows             "τ  ((X .oclAsType(Person))  invalid)"
using isOclAny non_null
apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
                  OclAsTypeOclAny_Person OclAsTypePerson_OclAny foundation22 foundation16
           split: option.split typeOclAny.split typePerson.split)
by(simp add: OclIsKindOfPerson_OclAny  OclValid_def false_def true_def)

section‹OclAllInstances›

text‹To denote OCL-types occurring in OCL expressions syntactically---as, for example,  as
``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
functions into the object universes; we show that this is sufficient ``characterization.''›

definition "Person  OclAsTypePerson_𝔄"
definition "OclAny  OclAsTypeOclAny_𝔄"
lemmas [simp] = Person_def OclAny_def

lemma OclAllInstances_genericOclAny_exec: "OclAllInstances_generic pre_post OclAny =
             (λτ.  Abs_Setbase   Some ` OclAny ` ran (heap (pre_post τ)) )"
proof -
 let ?S1 = "λτ. OclAny ` ran (heap (pre_post τ))"
 let ?S2 = "λτ. ?S1 τ - {None}"
 have B : "τ. ?S2 τ  ?S1 τ" by auto
 have C : "τ. ?S1 τ  ?S2 τ" by(auto simp: OclAsTypeOclAny_𝔄_some)

 show ?thesis by(insert equalityI[OF B C], simp)
qed

lemma OclAllInstances_at_postOclAny_exec: "OclAny .allInstances() =
             (λτ.  Abs_Setbase   Some ` OclAny ` ran (heap (snd τ)) )"
unfolding OclAllInstances_at_post_def
by(rule OclAllInstances_genericOclAny_exec)

lemma OclAllInstances_at_preOclAny_exec: "OclAny .allInstances@pre() =
             (λτ.  Abs_Setbase   Some ` OclAny ` ran (heap (fst τ)) ) "
unfolding OclAllInstances_at_pre_def
by(rule OclAllInstances_genericOclAny_exec)

subsection‹OclIsTypeOf›

lemma OclAny_allInstances_generic_oclIsTypeOfOclAny1:
assumes [simp]: "x. pre_post (x, x) = x"
shows "τ. (τ      ((OclAllInstances_generic pre_post OclAny)->forAllSet(X|X .oclIsTypeOf(OclAny))))"
 apply(rule_tac x = τ0 in exI, simp add: τ0_def OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: assms UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
by(simp add: OclIsTypeOfOclAny_OclAny)

lemma OclAny_allInstances_at_post_oclIsTypeOfOclAny1:
"τ. (τ      (OclAny .allInstances()->forAllSet(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsTypeOfOclAny1, simp)

lemma OclAny_allInstances_at_pre_oclIsTypeOfOclAny1:
"τ. (τ      (OclAny .allInstances@pre()->forAllSet(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsTypeOfOclAny1, simp)

lemma OclAny_allInstances_generic_oclIsTypeOfOclAny2:
assumes [simp]: "x. pre_post (x, x) = x"
shows "τ. (τ  not ((OclAllInstances_generic pre_post OclAny)->forAllSet(X|X .oclIsTypeOf(OclAny))))"
proof - fix oid a let ?t0 = "heap = Map.empty(oid  inOclAny (mkOclAny oid a)),
                              assocs = Map.empty" show ?thesis
 apply(rule_tac x = "(?t0, ?t0)" in exI, simp add: OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def OclAsTypeOclAny_𝔄_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
 by(simp add: OclIsTypeOfOclAny_OclAny OclNot_def OclAny_def)
qed

lemma OclAny_allInstances_at_post_oclIsTypeOfOclAny2:
"τ. (τ  not (OclAny .allInstances()->forAllSet(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsTypeOfOclAny2, simp)

lemma OclAny_allInstances_at_pre_oclIsTypeOfOclAny2:
"τ. (τ  not (OclAny .allInstances@pre()->forAllSet(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsTypeOfOclAny2, simp)

lemma Person_allInstances_generic_oclIsTypeOfPerson:
"τ  ((OclAllInstances_generic pre_post Person)->forAllSet(X|X .oclIsTypeOf(Person)))"
 apply(simp add: OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
by(simp add: OclIsTypeOfPerson_Person)

lemma Person_allInstances_at_post_oclIsTypeOfPerson:
"τ  (Person .allInstances()->forAllSet(X|X .oclIsTypeOf(Person)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsTypeOfPerson)

lemma Person_allInstances_at_pre_oclIsTypeOfPerson:
"τ  (Person .allInstances@pre()->forAllSet(X|X .oclIsTypeOf(Person)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsTypeOfPerson)

subsection‹OclIsKindOf›
lemma OclAny_allInstances_generic_oclIsKindOfOclAny:
"τ  ((OclAllInstances_generic pre_post OclAny)->forAllSet(X|X .oclIsKindOf(OclAny)))"
 apply(simp add: OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOfOclAny_OclAny)

lemma OclAny_allInstances_at_post_oclIsKindOfOclAny:
"τ  (OclAny .allInstances()->forAllSet(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsKindOfOclAny)

lemma OclAny_allInstances_at_pre_oclIsKindOfOclAny:
"τ  (OclAny .allInstances@pre()->forAllSet(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsKindOfOclAny)

lemma Person_allInstances_generic_oclIsKindOfOclAny:
"τ  ((OclAllInstances_generic pre_post Person)->forAllSet(X|X .oclIsKindOf(OclAny)))"
 apply(simp add: OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOfOclAny_Person)

lemma Person_allInstances_at_post_oclIsKindOfOclAny:
"τ  (Person .allInstances()->forAllSet(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsKindOfOclAny)

lemma Person_allInstances_at_pre_oclIsKindOfOclAny:
"τ  (Person .allInstances@pre()->forAllSet(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsKindOfOclAny)

lemma Person_allInstances_generic_oclIsKindOfPerson:
"τ  ((OclAllInstances_generic pre_post Person)->forAllSet(X|X .oclIsKindOf(Person)))"
 apply(simp add: OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOfPerson_Person)

lemma Person_allInstances_at_post_oclIsKindOfPerson:
"τ  (Person .allInstances()->forAllSet(X|X .oclIsKindOf(Person)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsKindOfPerson)

lemma Person_allInstances_at_pre_oclIsKindOfPerson:
"τ  (Person .allInstances@pre()->forAllSet(X|X .oclIsKindOf(Person)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsKindOfPerson)

section‹The Accessors (any, boss, salary)›
text‹\label{sec:eam-accessors}›
text‹Should be generated entirely from a class-diagram.›


subsection‹Definition (of the association Employee-Boss)›

text‹We start with a oid for the association; this oid can be used
in presence of association classes to represent the association inside an object,
pretty much similar to the \inlineisar+Design_UML+, where we stored
an \verb+oid+ inside the class as ``pointer.''›

definition oidPersonℬ𝒪𝒮𝒮 ::"oid" where "oidPersonℬ𝒪𝒮𝒮 = 10"

text‹From there on, we can already define an empty state which must contain
for $\mathit{oid}_{Person}\mathcal{BOSS}$ the empty relation (encoded as association list, since there are
associations with a Sequence-like structure).›


definition eval_extract :: "('𝔄,('a::object) option option) val
                             (oid  ('𝔄,'c::null) val)
                             ('𝔄,'c::null) val"
where "eval_extract X f = (λ τ. case X τ of
                                      invalid τ   ― ‹exception propagation›
                               |      invalid τ ― ‹dereferencing null pointer›
                               |  obj   f (oid_of obj) τ)"

definition "choose2_1 = fst"
definition "choose2_2 = snd"

definition "List_flatten = (λl. (foldl ((λacc. (λl. (foldl ((λacc. (λl. (Cons (l) (acc))))) (acc) ((rev (l))))))) (Nil) ((rev (l)))))"
definition "deref_assocs2" :: "('𝔄 state × '𝔄 state  '𝔄 state)
                               (oid list list  oid list × oid list)
                               oid
                               (oid list  ('𝔄,'f)val)
                               oid
                               ('𝔄, 'f::null)val"
where      "deref_assocs2 pre_post to_from assoc_oid f oid =
                 (λτ. case (assocs (pre_post τ)) assoc_oid of
                       S   f (List_flatten (map (choose2_2  to_from)
                                     (filter (λ p. List.member (choose2_1 (to_from p)) oid) S)))
                                 τ
                     | _     invalid τ)"


text‹The pre_post›-parameter is configured with fst› or
snd›, the to_from›-parameter either with the identity @{term id} or
the following combinator switch›:›
definition "switch2_1 = (λ[x,y] (x,y))"
definition "switch2_2 = (λ[x,y] (y,x))"
definition "switch3_1 = (λ[x,y,z] (x,y))"
definition "switch3_2 = (λ[x,y,z] (x,z))"
definition "switch3_3 = (λ[x,y,z] (y,x))"
definition "switch3_4 = (λ[x,y,z] (y,z))"
definition "switch3_5 = (λ[x,y,z] (z,x))"
definition "switch3_6 = (λ[x,y,z] (z,y))"

definition deref_oidPerson :: "(𝔄 state × 𝔄 state  𝔄 state)
                              (typePerson  (𝔄, 'c::null)val)
                              oid
                              (𝔄, 'c::null)val"
where "deref_oidPerson fst_snd f oid = (λτ. case (heap (fst_snd τ)) oid of
                                               inPerson obj   f obj τ
                                            | _               invalid τ)"



definition deref_oidOclAny :: "(𝔄 state × 𝔄 state  𝔄 state)
                              (typeOclAny  (𝔄, 'c::null)val)
                              oid
                              (𝔄, 'c::null)val"
where "deref_oidOclAny fst_snd f oid = (λτ. case (heap (fst_snd τ)) oid of
                        inOclAny obj   f obj τ
                     | _        invalid τ)"

text‹pointer undefined in state or not referencing a type conform object representation›


definition "selectOclAny𝒜𝒩𝒴 f = (λ X. case X of
                     (mkOclAny _ )  null
                   | (mkOclAny _ any)  f (λx _. x) any)"


definition "selectPersonℬ𝒪𝒮𝒮 f = select_object mtSet UML_Set.OclIncluding UML_Set.OclANY (f (λx _. x))"


definition "selectPerson𝒮𝒜ℒ𝒜ℛ𝒴 f = (λ X. case X of
                     (mkPerson _ )  null
                   | (mkPerson _ salary)  f (λx _. x) salary)"


definition "deref_assocs2ℬ𝒪𝒮𝒮 fst_snd f = (λ mkPerson oid _ 
              deref_assocs2 fst_snd switch2_1 oidPersonℬ𝒪𝒮𝒮 f oid)"

definition "in_pre_state = fst"
definition "in_post_state = snd"

definition "reconst_basetype = (λ convert x. convert x)"

definition dotOclAny𝒜𝒩𝒴 :: "OclAny  _"  ("(1(_).any)" 50)
  where "(X).any = eval_extract X
                     (deref_oidOclAny in_post_state
                       (selectOclAny𝒜𝒩𝒴
                         reconst_basetype))"

definition dotPersonℬ𝒪𝒮𝒮 :: "Person  Person"  ("(1(_).boss)" 50)
  where "(X).boss = eval_extract X
                      (deref_oidPerson in_post_state
                        (deref_assocs2ℬ𝒪𝒮𝒮 in_post_state
                          (selectPersonℬ𝒪𝒮𝒮
                            (deref_oidPerson in_post_state))))"

definition dotPerson𝒮𝒜ℒ𝒜ℛ𝒴 :: "Person  Integer"  ("(1(_).salary)" 50)
  where "(X).salary = eval_extract X
                        (deref_oidPerson in_post_state
                          (selectPerson𝒮𝒜ℒ𝒜ℛ𝒴
                            reconst_basetype))"

definition dotOclAny𝒜𝒩𝒴_at_pre :: "OclAny  _"  ("(1(_).any@pre)" 50)
  where "(X).any@pre = eval_extract X
                         (deref_oidOclAny in_pre_state
                           (selectOclAny𝒜𝒩𝒴
                             reconst_basetype))"

definition dotPersonℬ𝒪𝒮𝒮_at_pre:: "Person  Person"  ("(1(_).boss@pre)" 50)
  where "(X).boss@pre = eval_extract X
                          (deref_oidPerson in_pre_state
                            (deref_assocs2ℬ𝒪𝒮𝒮 in_pre_state
                              (selectPersonℬ𝒪𝒮𝒮
                                (deref_oidPerson in_pre_state))))"

definition dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre:: "Person  Integer"  ("(1(_).salary@pre)" 50)
  where "(X).salary@pre = eval_extract X
                            (deref_oidPerson in_pre_state
                              (selectPerson𝒮𝒜ℒ𝒜ℛ𝒴
                                reconst_basetype))"

lemmas dot_accessor =
  dotOclAny𝒜𝒩𝒴_def
  dotPersonℬ𝒪𝒮𝒮_def
  dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_def
  dotOclAny𝒜𝒩𝒴_at_pre_def
  dotPersonℬ𝒪𝒮𝒮_at_pre_def
  dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_def

subsection‹Context Passing›

lemmas [simp] = eval_extract_def

lemma cp_dotOclAny𝒜𝒩𝒴: "((X).any) τ = ((λ_. X τ).any) τ" by (simp add: dot_accessor)
lemma cp_dotPersonℬ𝒪𝒮𝒮: "((X).boss) τ = ((λ_. X τ).boss) τ" by (simp add: dot_accessor)
lemma cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴: "((X).salary) τ = ((λ_. X τ).salary) τ" by (simp add: dot_accessor)

lemma cp_dotOclAny𝒜𝒩𝒴_at_pre: "((X).any@pre) τ = ((λ_. X τ).any@pre) τ" by (simp add: dot_accessor)
lemma cp_dotPersonℬ𝒪𝒮𝒮_at_pre: "((X).boss@pre) τ = ((λ_. X τ).boss@pre) τ" by (simp add: dot_accessor)
lemma cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre: "((X).salary@pre) τ = ((λ_. X τ).salary@pre) τ" by (simp add: dot_accessor)

lemmas cp_dotOclAny𝒜𝒩𝒴_I [simp, intro!]=
       cp_dotOclAny𝒜𝒩𝒴[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dotOclAny𝒜𝒩𝒴_at_pre_I [simp, intro!]=
       cp_dotOclAny𝒜𝒩𝒴_at_pre[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]

lemmas cp_dotPersonℬ𝒪𝒮𝒮_I [simp, intro!]=
       cp_dotPersonℬ𝒪𝒮𝒮[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dotPersonℬ𝒪𝒮𝒮_at_pre_I [simp, intro!]=
       cp_dotPersonℬ𝒪𝒮𝒮_at_pre[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]

lemmas cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_I [simp, intro!]=
       cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_I [simp, intro!]=
       cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]

subsection‹Execution with Invalid or Null as Argument›

lemma dotOclAny𝒜𝒩𝒴_nullstrict [simp]: "(null).any = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotOclAny𝒜𝒩𝒴_at_pre_nullstrict [simp] : "(null).any@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotOclAny𝒜𝒩𝒴_strict [simp] : "(invalid).any = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotOclAny𝒜𝒩𝒴_at_pre_strict [simp] : "(invalid).any@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)


lemma dotPersonℬ𝒪𝒮𝒮_nullstrict [simp]: "(null).boss = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPersonℬ𝒪𝒮𝒮_at_pre_nullstrict [simp] : "(null).boss@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPersonℬ𝒪𝒮𝒮_strict [simp] : "(invalid).boss = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPersonℬ𝒪𝒮𝒮_at_pre_strict [simp] : "(invalid).boss@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)


lemma dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_nullstrict [simp]: "(null).salary = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_nullstrict [simp] : "(null).salary@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_strict [simp] : "(invalid).salary = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_strict [simp] : "(invalid).salary@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)

subsection‹Representation in States›

lemma dotPersonℬ𝒪𝒮𝒮_def_mono:"τ  δ(X .boss)  τ  δ(X)"
  apply(case_tac "τ  (X  invalid)", insert StrongEq_L_subst2[where P = "(λx. (δ (x .boss)))" and τ = "τ" and x = "X" and y = "invalid"], simp add: foundation16')
  apply(case_tac "τ  (X  null)", insert StrongEq_L_subst2[where P = "(λx. (δ (x .boss)))" and τ = "τ" and x = "X" and y = "null"], simp add: foundation16')
by(simp add: defined_split)

lemma repr_boss:  
assumes A : "τ  δ(x .boss)"
shows      "is_represented_in_state in_post_state (x .boss) Person τ"
         apply(insert A[simplified foundation16]
                      A[THEN dotPersonℬ𝒪𝒮𝒮_def_mono, simplified foundation16])
         unfolding is_represented_in_state_def
                   dotPersonℬ𝒪𝒮𝒮_def eval_extract_def selectPersonℬ𝒪𝒮𝒮_def in_post_state_def
         oops

lemma repr_bossX : 
assumes A: "τ  δ(x .boss)"
shows "τ  ((Person .allInstances()) ->includesSet(x .boss))"
oops

section‹A Little Infra-structure on Example States›

text‹
The example we are defining in this section comes from the figure~\ref{fig:eam1_system-states}.
\begin{figure}
\includegraphics[width=\textwidth]{figures/pre-post.pdf}
\caption{(a) pre-state $\sigma_1$ and
  (b) post-state $\sigma_1'$.}
\label{fig:eam1_system-states}
\end{figure}
›

text_raw‹\isatagafp›

definition OclInt1000 ("𝟭𝟬𝟬𝟬") where "OclInt1000 = (λ _ . 1000)"
definition OclInt1200 ("𝟭𝟮𝟬𝟬") where "OclInt1200 = (λ _ . 1200)"
definition OclInt1300 ("𝟭𝟯𝟬𝟬") where "OclInt1300 = (λ _ . 1300)"
definition OclInt1800 ("𝟭𝟴𝟬𝟬") where "OclInt1800 = (λ _ . 1800)"
definition OclInt2600 ("𝟮𝟲𝟬𝟬") where "OclInt2600 = (λ _ . 2600)"
definition OclInt2900 ("𝟮𝟵𝟬𝟬") where "OclInt2900 = (λ _ . 2900)"
definition OclInt3200 ("𝟯𝟮𝟬𝟬") where "OclInt3200 = (λ _ . 3200)"
definition OclInt3500 ("𝟯𝟱𝟬𝟬") where "OclInt3500 = (λ _ . 3500)"

definition "oid0  0"
definition "oid1  1"
definition "oid2  2"
definition "oid3  3"
definition "oid4  4"
definition "oid5  5"
definition "oid6  6"
definition "oid7  7"
definition "oid8  8"

definition "person1  mkPerson oid0 1300"
definition "person2  mkPerson oid1 1800"
definition "person3  mkPerson oid2 None"
definition "person4  mkPerson oid3 2900"
definition "person5  mkPerson oid4 3500"
definition "person6  mkPerson oid5 2500"
definition "person7  mkOclAny oid6 3200"
definition "person8  mkOclAny oid7 None"
definition "person9  mkPerson oid8 0"

text_raw‹\endisatagafp›

definition
      "σ1    heap = Map.empty(oid0  inPerson (mkPerson oid0 1000))
                           (oid1  inPerson (mkPerson oid1 1200))
                           ⌦‹oid2›
                           (oid3  inPerson (mkPerson oid3 2600))
                           (oid4  inPerson person5)
                           (oid5  inPerson (mkPerson oid5 2300))
                           ⌦‹oid6›
                           ⌦‹oid7›
                           (oid8  inPerson person9),
               assocs = Map.empty(oidPersonℬ𝒪𝒮𝒮  [[[oid0],[oid1]],[[oid3],[oid4]],[[oid5],[oid3]]]) "

definition
      "σ1'   heap = Map.empty(oid0  inPerson person1)
                           (oid1  inPerson person2)
                           (oid2  inPerson person3)
                           (oid3  inPerson person4)
                           ⌦‹oid4›
                           (oid5  inPerson person6)
                           (oid6  inOclAny person7)
                           (oid7  inOclAny person8)
                           (oid8  inPerson person9),
               assocs = Map.empty(oidPersonℬ𝒪𝒮𝒮  [[[oid0],[oid1]],[[oid1],[oid1]],[[oid5],[oid6]],[[oid6],[oid6]]]) "

definition "σ0   heap = Map.empty, assocs = Map.empty "


lemma basic_τ_wff: "WFF(σ1,σ1')"
by(auto simp: WFF_def σ1_def σ1'_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
              oid_of_𝔄_def oid_of_typePerson_def oid_of_typeOclAny_def
              person1_def person2_def person3_def person4_def
              person5_def person6_def person7_def person8_def person9_def)

lemma [simp,code_unfold]: "dom (heap σ1) = {oid0,oid1⌦‹,oid2›,oid3,oid4,oid5⌦‹,oid6,oid7›,oid8}"
by(auto simp: σ1_def)

lemma [simp,code_unfold]: "dom (heap σ1') = {oid0,oid1,oid2,oid3⌦‹,oid4›,oid5,oid6,oid7,oid8}"
by(auto simp: σ1'_def)

text_raw‹\isatagafp›

definition "XPerson1 :: Person  λ _ . person1 "
definition "XPerson2 :: Person  λ _ . person2 "
definition "XPerson3 :: Person  λ _ . person3 "
definition "XPerson4 :: Person  λ _ . person4 "
definition "XPerson5 :: Person  λ _ . person5 "
definition "XPerson6 :: Person  λ _ . person6 "
definition "XPerson7 :: OclAny  λ _ . person7 "
definition "XPerson8 :: OclAny  λ _ . person8 "
definition "XPerson9 :: Person  λ _ . person9 "

lemma [code_unfold]: "((x::Person)  y) = StrictRefEqObject x y" by(simp only: StrictRefEqObject_Person)
lemma [code_unfold]: "((x::OclAny)  y) = StrictRefEqObject x y" by(simp only: StrictRefEqObject_OclAny)

lemmas [simp,code_unfold] =
 OclAsTypeOclAny_OclAny
 OclAsTypeOclAny_Person
 OclAsTypePerson_OclAny
 OclAsTypePerson_Person

 OclIsTypeOfOclAny_OclAny
 OclIsTypeOfOclAny_Person
 OclIsTypeOfPerson_OclAny
 OclIsTypeOfPerson_Person

 OclIsKindOfOclAny_OclAny
 OclIsKindOfOclAny_Person
 OclIsKindOfPerson_OclAny
 OclIsKindOfPerson_Person
text_raw‹\endisatagafp›

Assert "spre     .   (spre,σ1')       (XPerson1 .salary    <> 𝟭𝟬𝟬𝟬)"
Assert "spre     .   (spre,σ1')       (XPerson1 .salary     𝟭𝟯𝟬𝟬)"
Assert "    spost.   (σ1,spost)       (XPerson1 .salary@pre      𝟭𝟬𝟬𝟬)"
Assert "    spost.   (σ1,spost)       (XPerson1 .salary@pre     <> 𝟭𝟯𝟬𝟬)"
(*Assert "⋀spre     .   (spre1') ⊨      (XPerson1 .boss   <> XPerson1)"
Assert "⋀spre     .   (spre1') ⊨      (XPerson1 .boss .salary   ≐ 𝟭𝟴𝟬𝟬)"
Assert "⋀spre     .   (spre1') ⊨      (XPerson1 .boss .boss  <> XPerson1)"
Assert "⋀spre     .   (spre1') ⊨      (XPerson1 .boss .boss  ≐ XPerson2)"
Assert "               (σ11') ⊨      (XPerson1 .boss@pre .salary  ≐ 𝟭𝟴𝟬𝟬)"
Assert "⋀    spost.   (σ1,spost) ⊨      (XPerson1 .boss@pre .salary@pre  ≐ 𝟭𝟮𝟬𝟬)"
Assert "⋀    spost.   (σ1,spost) ⊨      (XPerson1 .boss@pre .salary@pre  <> 𝟭𝟴𝟬𝟬)"
Assert "⋀    spost.   (σ1,spost) ⊨      (XPerson1 .boss@pre  ≐ XPerson2)"
Assert "               (σ11') ⊨      (XPerson1 .boss@pre .boss  ≐ XPerson2)"
Assert "⋀    spost.   (σ1,spost) ⊨      (XPerson1 .boss@pre .boss@pre  ≐ null)"
Assert "⋀    spost.   (σ1,spost) ⊨ not(υ(XPerson1 .boss@pre .boss@pre .boss@pre))"
*)
lemma "               (σ1,σ1')       (XPerson1 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def
             σ1_def σ1'_def
             XPerson1_def person1_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
             oid_of_option_def oid_of_typePerson_def)

lemma "spre spost.   (spre,spost)     ((XPerson1 .oclAsType(OclAny) .oclAsType(Person))  XPerson1)"
by(rule up_down_cast_Person_OclAny_Person', simp add: XPerson1_def)
Assert "spre spost.   (spre,spost)      (XPerson1 .oclIsTypeOf(Person))"
Assert "spre spost.   (spre,spost)   not(XPerson1 .oclIsTypeOf(OclAny))"
Assert "spre spost.   (spre,spost)      (XPerson1 .oclIsKindOf(Person))"
Assert "spre spost.   (spre,spost)      (XPerson1 .oclIsKindOf(OclAny))"
Assert "spre spost.   (spre,spost)   not(XPerson1 .oclAsType(OclAny) .oclIsTypeOf(OclAny))"


Assert "spre     .   (spre,σ1')       (XPerson2 .salary        𝟭𝟴𝟬𝟬)"
Assert "    spost.   (σ1,spost)       (XPerson2 .salary@pre    𝟭𝟮𝟬𝟬)"
(*Assert "⋀spre     .   (spre1') ⊨      (XPerson2 .boss      ≐ XPerson2)"
Assert "               (σ11') ⊨      (XPerson2 .boss .salary@pre      ≐ 𝟭𝟮𝟬𝟬)"
Assert "               (σ11') ⊨      (XPerson2 .boss .boss@pre      ≐ null)"
Assert "⋀    spost.   (σ1,spost) ⊨      (XPerson2 .boss@pre  ≐ null)"
Assert "⋀    spost.   (σ1,spost) ⊨      (XPerson2 .boss@pre  <> XPerson2)"
Assert "               (σ11') ⊨      (XPerson2 .boss@pre  <> (XPerson2 .boss))"
Assert "⋀    spost.   (σ1,spost) ⊨ not(υ(XPerson2 .boss@pre .boss))"
Assert "⋀    spost.   (σ1,spost) ⊨ not(υ(XPerson2 .boss@pre .salary@pre))"
*)
lemma "               (σ1,σ1')       (XPerson2 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ1_def σ1'_def XPerson2_def person2_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
             oid_of_option_def oid_of_typePerson_def)

Assert "spre     .   (spre,σ1')       (XPerson3 .salary        null)"
Assert "    spost.   (σ1,spost)  not(υ(XPerson3 .salary@pre))"
(*Assert "⋀spre     .   (spre1') ⊨      (XPerson3 .boss       ≐ null)"
Assert "⋀spre     .   (spre1') ⊨ not(υ(XPerson3 .boss .salary))"
Assert "⋀    spost.   (σ1,spost) ⊨ not(υ(XPerson3 .boss@pre))"
*)lemma "               (σ1,σ1')       (XPerson3 .oclIsNew())"
by(simp add: OclValid_def OclIsNew_def σ1_def σ1'_def XPerson3_def person3_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
             oid_of_option_def oid_of_typePerson_def)


(*Assert "⋀    spost.   (σ1,spost) ⊨      (XPerson4 .boss@pre   ≐ XPerson5)"
Assert "               (σ11') ⊨ not(υ(XPerson4 .boss@pre .salary))"
Assert "⋀    spost.   (σ1,spost) ⊨      (XPerson4 .boss@pre .salary@pre   ≐ 𝟯𝟱𝟬𝟬)"
*)
lemma "               (σ1,σ1')       (XPerson4 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ1_def σ1'_def XPerson4_def person4_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
             oid_of_option_def oid_of_typePerson_def)

Assert "spre     .   (spre,σ1')  not(υ(XPerson5 .salary))"
Assert "    spost.   (σ1,spost)       (XPerson5 .salary@pre    𝟯𝟱𝟬𝟬)"
(*Assert "⋀spre     .   (spre1') ⊨ not(υ(XPerson5 .boss))"
*)
lemma "               (σ1,σ1')       (XPerson5 .oclIsDeleted())"
by(simp add: OclNot_def OclValid_def OclIsDeleted_def σ1_def σ1'_def XPerson5_def person5_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
             oid_of_option_def oid_of_typePerson_def)

(* (* access to an oclany object not yet supported *) Assert "  (σ11') ⊨     ((XPerson6 .boss .salary)   ≐ 𝟯𝟮𝟬𝟬 )"*)
(*Assert "⋀spre     .   (spre1') ⊨ not(υ(XPerson6 .boss .salary@pre))"
Assert "⋀    spost.   (σ1,spost) ⊨      (XPerson6 .boss@pre   ≐ XPerson4)"
Assert "               (σ11') ⊨      (XPerson6 .boss@pre .salary   ≐ 𝟮𝟵𝟬𝟬)"
Assert "⋀    spost.   (σ1,spost) ⊨      (XPerson6 .boss@pre .salary@pre   ≐ 𝟮𝟲𝟬𝟬)"
Assert "⋀    spost.   (σ1,spost) ⊨      (XPerson6 .boss@pre .boss@pre  ≐ XPerson5)"
*)
lemma "               (σ1,σ1')       (XPerson6 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ1_def σ1'_def XPerson6_def person6_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
             oid_of_option_def oid_of_typePerson_def)

(* (* access to an oclany object not yet supported *) Assert "  (σ11') ⊨     ((XPerson7 .oclAsType(Person)   ≐  (XPerson6 .boss)))" *)
(* (* access to an oclany object not yet supported *) Assert "  (σ11') ⊨     ((XPerson7 .oclAsType(Person) .boss)   ≐ (XPerson7 .oclAsType(Person)) )" *)
(* (* access to an oclany object not yet supported *) Assert "  (σ11') ⊨     ((XPerson7 .oclAsType(Person) .boss .salary)   ≐ 𝟯𝟮𝟬𝟬 )" *)
Assert "spre spost.   (spre,spost)      υ(XPerson7 .oclAsType(Person))"
(*Assert "⋀    spost.    (σ1,spost) ⊨ not(υ(XPerson7 .oclAsType(Person) .boss@pre))"
*)
lemma "spre spost.   (spre,spost)      ((XPerson7 .oclAsType(Person) .oclAsType(OclAny)
                                                                   .oclAsType(Person))
                                       (XPerson7 .oclAsType(Person)))"
by(rule up_down_cast_Person_OclAny_Person', simp add: XPerson7_def OclValid_def valid_def person7_def)
lemma "               (σ1,σ1')        (XPerson7 .oclIsNew())"
by(simp add: OclValid_def OclIsNew_def  σ1_def σ1'_def  XPerson7_def person7_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
             oid_of_option_def oid_of_typeOclAny_def)

Assert "spre spost.   (spre,spost)       (XPerson8  <> XPerson7)"
Assert "spre spost.   (spre,spost)  not(υ(XPerson8 .oclAsType(Person)))"
Assert "spre spost.   (spre,spost)       (XPerson8 .oclIsTypeOf(OclAny))"
Assert "spre spost.   (spre,spost)    not(XPerson8 .oclIsTypeOf(Person))"
Assert "spre spost.   (spre,spost)    not(XPerson8 .oclIsKindOf(Person))"
Assert "spre spost.   (spre,spost)       (XPerson8 .oclIsKindOf(OclAny))"

lemma σ_modifiedonly: "(σ1,σ1')  (Set{ XPerson1 .oclAsType(OclAny)
                      , XPerson2 .oclAsType(OclAny)
                      ⌦‹, XPerson3 .oclAsType(OclAny)›
                      , XPerson4 .oclAsType(OclAny)
                      ⌦‹, XPerson5 .oclAsType(OclAny)›
                      , XPerson6 .oclAsType(OclAny)
                      ⌦‹, XPerson7 .oclAsType(OclAny)›
                      ⌦‹, XPerson8 .oclAsType(OclAny)›
                      ⌦‹, XPerson9 .oclAsType(OclAny)›}->oclIsModifiedOnly())"
 apply(simp add: OclIsModifiedOnly_def OclValid_def
                 oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                 XPerson1_def XPerson2_def XPerson3_def XPerson4_def
                 XPerson5_def XPerson6_def XPerson7_def XPerson8_def XPerson9_def
                 person1_def person2_def person3_def person4_def
                 person5_def person6_def person7_def person8_def person9_def
                 image_def)
 apply(simp add: OclIncluding_rep_set mtSet_rep_set null_option_def bot_option_def)
 apply(simp add: oid_of_option_def oid_of_typeOclAny_def, clarsimp)
 apply(simp add: σ1_def σ1'_def
                 oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
done

lemma "(σ1,σ1')  ((XPerson9 @pre (λx. OclAsTypePerson_𝔄 x))   XPerson9)"
by(simp add: OclSelf_at_pre_def σ1_def oid_of_option_def oid_of_typePerson_def
             XPerson9_def person9_def oid8_def OclValid_def StrongEq_def OclAsTypePerson_𝔄_def)

lemma "(σ1,σ1')  ((XPerson9 @post (λx. OclAsTypePerson_𝔄 x))   XPerson9)"
by(simp add: OclSelf_at_post_def σ1'_def oid_of_option_def oid_of_typePerson_def
             XPerson9_def person9_def oid8_def OclValid_def StrongEq_def OclAsTypePerson_𝔄_def)

lemma "(σ1,σ1')  (((XPerson9 .oclAsType(OclAny)) @pre (λx. OclAsTypeOclAny_𝔄 x)) 
                   ((XPerson9 .oclAsType(OclAny)) @post (λx. OclAsTypeOclAny_𝔄 x)))"
proof -

 have including4 : "a b c d τ.
        Set{λτ. a, λτ. b, λτ. c, λτ. d} τ = Abs_Setbase  {a, b, c, d} "
  apply(subst abs_rep_simp'[symmetric], simp)
  apply(simp add: OclIncluding_rep_set mtSet_rep_set)
  by(rule arg_cong[of _ _ "λx. (Abs_Setbase( x ))"], auto)

 have excluding1: "S a b c d e τ.
                   (λ_. Abs_Setbase  {a, b, c, d} )->excludingSet(λτ. e) τ =
                   Abs_Setbase  {a, b, c, d} - {e} "
  apply(simp add: UML_Set.OclExcluding_def)
  apply(simp add: defined_def OclValid_def false_def true_def
                  bot_fun_def bot_Setbase_def null_fun_def null_Setbase_def)
  apply(rule conjI)
   apply(rule impI, subst (asm) Abs_Setbase_inject) apply( simp add: bot_option_def)+
  apply(rule conjI)
   apply(rule impI, subst (asm) Abs_Setbase_inject) apply( simp add: bot_option_def null_option_def)+
  apply(subst Abs_Setbase_inverse, simp add: bot_option_def, simp)
 done

 show ?thesis
  apply(rule framing[where X = "Set{ XPerson1 .oclAsType(OclAny)
                       , XPerson2 .oclAsType(OclAny)
                       ⌦‹, XPerson3 .oclAsType(OclAny)›
                       , XPerson4 .oclAsType(OclAny)
                       ⌦‹, XPerson5 .oclAsType(OclAny)›
                       , XPerson6 .oclAsType(OclAny)
                       ⌦‹, XPerson7 .oclAsType(OclAny)›
                       ⌦‹, XPerson8 .oclAsType(OclAny)›
                       ⌦‹, XPerson9 .oclAsType(OclAny)›}"])
   apply(cut_tac σ_modifiedonly)
   apply(simp only: OclValid_def
                    XPerson1_def XPerson2_def XPerson3_def XPerson4_def
                    XPerson5_def XPerson6_def XPerson7_def XPerson8_def XPerson9_def
                    person1_def person2_def person3_def person4_def
                    person5_def person6_def person7_def person8_def person9_def
                    OclAsTypeOclAny_Person)
   apply(subst cp_OclIsModifiedOnly, subst UML_Set.OclExcluding.cp0,
     subst (asm) cp_OclIsModifiedOnly, simp add: including4 excluding1)

  apply(simp only: XPerson1_def XPerson2_def XPerson3_def XPerson4_def
                   XPerson5_def XPerson6_def XPerson7_def XPerson8_def XPerson9_def
                   person1_def person2_def person3_def person4_def
                   person5_def person6_def person7_def person8_def person9_def)
  apply(simp add: OclIncluding_rep_set mtSet_rep_set
                  oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
  apply(simp add: StrictRefEqObject_def oid_of_option_def oid_of_typeOclAny_def OclNot_def OclValid_def
                  null_option_def bot_option_def)
 done
qed

lemma perm_σ1' : 1' =  heap = Map.empty
                           (oid8  inPerson person9)
                           (oid7  inOclAny person8)
                           (oid6  inOclAny person7)
                           (oid5  inPerson person6)
                           ⌦‹oid4›
                           (oid3  inPerson person4)
                           (oid2  inPerson person3)
                           (oid1  inPerson person2)
                           (oid0  inPerson person1)
                       , assocs = assocs σ1' "
proof -
 note P = fun_upd_twist
 show ?thesis
  apply(simp add: σ1'_def
                  oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
  apply(subst (1) P, simp)
  apply(subst (2) P, simp) apply(subst (1) P, simp)
  apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
  apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
  apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
  apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
  apply(subst (7) P, simp) apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
 by(simp)
qed

declare const_ss [simp]

lemma "σ1.
 (σ1,σ1')  (Person .allInstances()  Set{ XPerson1, XPerson2, XPerson3, XPerson4⌦‹, XPerson5›, XPerson6,
                                           XPerson7 .oclAsType(Person)⌦‹, XPerson8›, XPerson9 })"
 apply(subst perm_σ1')
 apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                  XPerson1_def XPerson2_def XPerson3_def XPerson4_def
                  XPerson5_def XPerson6_def XPerson7_def XPerson8_def XPerson9_def
                  person7_def)
 apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
  apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
   apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
    apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
     apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
      apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
       apply(subst state_update_vs_allInstances_at_post_ntc, simp, simp add: OclAsTypePerson_𝔄_def
                                                                             person8_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp)
       apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
        apply(rule state_update_vs_allInstances_at_post_empty)
by(simp_all add: OclAsTypePerson_𝔄_def)

lemma "σ1.
 (σ1,σ1')  (OclAny .allInstances()  Set{ XPerson1 .oclAsType(OclAny), XPerson2 .oclAsType(OclAny),
                                           XPerson3 .oclAsType(OclAny), XPerson4 .oclAsType(OclAny)
                                           ⌦‹, XPerson5›, XPerson6 .oclAsType(OclAny),
                                           XPerson7, XPerson8, XPerson9 .oclAsType(OclAny) })"
 apply(subst perm_σ1')
 apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                  XPerson1_def XPerson2_def XPerson3_def XPerson4_def XPerson5_def XPerson6_def XPerson7_def XPerson8_def XPerson9_def
                  person1_def person2_def person3_def person4_def person5_def person6_def person9_def)
 apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypeOclAny_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)+
         apply(rule state_update_vs_allInstances_at_post_empty)
by(simp_all add: OclAsTypeOclAny_𝔄_def)

end

Theory Analysis_OCL

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * Analysis_OCL.thy --- OCL Contracts and an Example.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

theory
  Analysis_OCL
imports
  Analysis_UML
begin
text ‹\label{ex:employee-analysis:ocl}›

section‹OCL Part: Invariant›
text‹These recursive predicates can be defined conservatively
by greatest fix-point
constructions---automatically. See~\cite{brucker.ea:hol-ocl-book:2006,brucker:interactive:2007}
for details. For the purpose of this example, we state them as axioms
here.

\begin{ocl}
context Person
  inv label : self .boss <> null implies (self .salary  ≤  ((self .boss) .salary))
\end{ocl}
›

definition Person_labelinv :: "Person  Boolean" 
where     "Person_labelinv (self)   
                 (self .boss <> null implies (self .salary  int  ((self .boss) .salary)))"
                                       

definition Person_labelinvATpre :: "Person  Boolean" 
where     "Person_labelinvATpre (self)   
                 (self .boss@pre <> null implies (self .salary@pre int ((self .boss@pre) .salary@pre)))"

definition Person_labelglobalinv :: "Boolean"
where     "Person_labelglobalinv  (Person .allInstances()->forAllSet(x | Person_labelinv (x)) and 
                                  (Person .allInstances@pre()->forAllSet(x | Person_labelinvATpre (x))))"
                                  
                                  
lemma "τ  δ (X .boss)  τ  Person .allInstances()->includesSet(X .boss) 
                            τ  Person .allInstances()->includesSet(X) "
oops 
(* To be generated generically ... hard, but crucial lemma that should hold. 
   It means that X and it successor are object representation that actually
   occur in the state. *)

lemma REC_pre : "τ  Person_labelglobalinv 
        τ  Person .allInstances()->includesSet(X) ― ‹X› represented object in state›
         REC.  τ  REC(X)   (Person_labelinv (X) and (X .boss <> null implies REC(X .boss)))"
oops (* Attempt to allegiate the burden of he following axiomatizations: could be
        a witness for a constant specification ...*)       

text‹This allows to state a predicate:›
                                       
axiomatization invPerson_label :: "Person  Boolean"
where invPerson_label_def:
"(τ  Person .allInstances()->includesSet(self))  
 (τ  (invPerson_label(self)   (self .boss <> null implies  
                                  (self .salary  int  ((self .boss) .salary)) and
                                   invPerson_label(self .boss))))"

axiomatization invPerson_labelATpre :: "Person  Boolean"
where invPerson_labelATpre_def: 
"(τ  Person .allInstances@pre()->includesSet(self)) 
 (τ  (invPerson_labelATpre(self)  (self .boss@pre <> null implies 
                                   (self .salary@pre  int  ((self .boss@pre) .salary@pre)) and
                                    invPerson_labelATpre(self .boss@pre))))"


lemma inv_1 : 
"(τ  Person .allInstances()->includesSet(self)) 
    (τ  invPerson_label(self) = ((τ  (self .boss  null)) 
                               ( τ  (self .boss <> null)  
                                 τ  ((self .salary)  int  (self .boss .salary))  
                                 τ  (invPerson_label(self .boss))))) "
oops (* Let's hope that this holds ... *)


lemma inv_2 : 
"(τ  Person .allInstances@pre()->includesSet(self)) 
    (τ  invPerson_labelATpre(self)) =  ((τ  (self .boss@pre  null)) 
                                     (τ  (self .boss@pre <> null) 
                                     (τ  (self .boss@pre .salary@pre int self .salary@pre))  
                                     (τ  (invPerson_labelATpre(self .boss@pre)))))"
oops (* Let's hope that this holds ... *)

text‹A very first attempt to characterize the axiomatization by an inductive
definition - this can not be the last word since too weak (should be equality!)›
coinductive inv :: "Person  (𝔄)st  bool" where
 "(τ  (δ self))  ((τ  (self .boss  null)) 
                      (τ  (self .boss <> null)  (τ  (self .boss .salary int self .salary))  
                     ( (inv(self .boss))τ )))
                      ( inv self τ)"


section‹OCL Part: The Contract of a Recursive Query›
text‹The original specification of a recursive query :
\begin{ocl}
context Person::contents():Set(Integer)
pre:   true
post:  result = if self.boss = null
                then Set{i}
                else self.boss.contents()->including(i)
                endif
\end{ocl}›


                  
text‹For the case of recursive queries, we use at present just axiomatizations:›               
                  
axiomatization contents :: "Person  Set_Integer"  ("(1(_).contents'('))" 50)
where contents_def:
"(self .contents()) = (λ τ. SOME res. let res = λ _. res in
                            if τ  (δ self)
                            then ((τ  true) 
                                  (τ  res  if (self .boss  null)
                                              then (Set{self .salary})
                                              else (self .boss .contents()
                                                       ->includingSet(self .salary))
                                              endif))
                            else τ  res  invalid)"
and cp0_contents:"(X .contents()) τ = ((λ_. X τ) .contents()) τ"

interpretation contents : contract0 "contents" "λ self. true"  
                          "λ self res.  res  if (self .boss  null)
                                              then (Set{self .salary})
                                              else (self .boss .contents()
                                                       ->includingSet(self .salary))
                                              endif"  
         proof (unfold_locales)
            show "self τ. true τ = true τ" by auto
         next
            show "self. σ σ' σ''. ((σ, σ')  true) = ((σ, σ'')  true)" by auto
         next
            show "self. self .contents() 
                       λ τ. SOME res. let res = λ _. res in
                            if τ  (δ self)
                            then ((τ  true) 
                                  (τ  res  if (self .boss  null)
                                              then (Set{self .salary})
                                              else (self .boss .contents()
                                                       ->includingSet(self .salary))
                                              endif))
                            else τ  res  invalid"
                  by(auto simp: contents_def )
         next
            have A:"self τ. ((λ_. self τ) .boss  null) τ = (λ_. (self .boss  null) τ) τ" 
            by (metis (no_types) StrictRefEqObject_Person cp_StrictRefEqObject cp_dotPersonℬ𝒪𝒮𝒮)
            have B:"self τ. (λ_. Set{(λ_. self τ) .salary} τ) = (λ_. Set{self .salary} τ)" 
                   apply(subst UML_Set.OclIncluding.cp0)
                   apply(subst (2) UML_Set.OclIncluding.cp0)
                   apply(subst (2) Analysis_UML.cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴) by simp
            have C:"self τ. ((λ_. self τ).boss .contents()->includingSet((λ_. self τ).salary) τ) = 
                              (self .boss .contents() ->includingSet(self .salary) τ)" 
                   apply(subst UML_Set.OclIncluding.cp0) apply(subst (2) UML_Set.OclIncluding.cp0)   
                   apply(subst (2) Analysis_UML.cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴)
                   apply(subst cp0_contents)  apply(subst (2) cp0_contents)
                   apply(subst (2) cp_dotPersonℬ𝒪𝒮𝒮) by simp
            show "self res τ.
                   (res  if (self .boss)  null then Set{self .salary} 
                           else self .boss .contents()->includingSet(self .salary) endif) τ =
                   ((λ_. res τ)  if (λ_. self τ) .boss  null then Set{(λ_. self τ) .salary} 
                                   else(λ_. self τ) .boss .contents()->includingSet((λ_. self τ) .salary) endif) τ"
           apply(subst cp_StrongEq)
           apply(subst (2) cp_StrongEq)
           apply(subst cp_OclIf)
           apply(subst (2)cp_OclIf)
           by(simp add: A B C)
         qed

         
text‹Specializing @{thm contents.unfold2}, one gets the following more practical rewrite
rule that is amenable to symbolic evaluation:›
theorem unfold_contents :
   assumes "cp E"
   and     "τ  δ self"
   shows   "(τ  E (self .contents())) = 
            (τ  E (if self .boss  null 
                    then Set{self .salary} 
                    else self .boss .contents()->includingSet(self .salary) endif))"
by(rule contents.unfold2[of _ _ _ "λ X. true"], simp_all add: assms)


text‹Since we have only one interpretation function, we need the corresponding
operation on the pre-state:›               

consts contentsATpre :: "Person  Set_Integer"  ("(1(_).contents@pre'('))" 50)

axiomatization where contentsATpre_def:
" (self).contents@pre() = (λ τ.
      SOME res. let res = λ _. res in
      if τ  (δ self)
      then ((τ  true)                             ― ‹pre›
            (τ  (res  if (self).boss@pre  null  ― ‹post›
                         then Set{(self).salary@pre}
                         else (self).boss@pre .contents@pre()
                                    ->includingSet(self .salary@pre)
                         endif)))
      else τ  res  invalid)"
and cp0_contents_at_pre:"(X .contents@pre()) τ = ((λ_. X τ) .contents@pre()) τ"

interpretation contentsATpre : contract0 "contentsATpre" "λ self. true"  
                          "λ self res.  res  if (self .boss@pre  null)
                                                               then (Set{self .salary@pre})
                                                               else (self .boss@pre .contents@pre()
                                                                        ->includingSet(self .salary@pre))
                                                               endif"     
         proof (unfold_locales)
            show "self τ. true τ = true τ" by auto
         next
            show "self. σ σ' σ''. ((σ, σ')  true) = ((σ, σ'')  true)" by auto
         next
            show "self. self .contents@pre() 
                         λτ. SOME res. let res = λ _. res in
                             if τ  δ self
                             then τ  true 
                                  τ  res  (if self .boss@pre  null then Set{self .salary@pre} 
                                              else self .boss@pre .contents@pre()->includingSet(self .salary@pre) 
                                              endif)
                             else τ  res  invalid"
                  by(auto simp: contentsATpre_def)
         next
            have A:"self τ. ((λ_. self τ) .boss@pre  null) τ = (λ_. (self .boss@pre  null) τ) τ" 
            by (metis StrictRefEqObject_Person cp_StrictRefEqObject cp_dotPersonℬ𝒪𝒮𝒮_at_pre)
            have B:"self τ. (λ_. Set{(λ_. self τ) .salary@pre} τ) = (λ_. Set{self .salary@pre} τ)"
                   apply(subst UML_Set.OclIncluding.cp0)
                   apply(subst (2) UML_Set.OclIncluding.cp0)
                   apply(subst (2) Analysis_UML.cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre) by simp
            have C:"self τ. ((λ_. self τ).boss@pre .contents@pre()->includingSet((λ_. self τ).salary@pre) τ) = 
                              (self .boss@pre .contents@pre() ->includingSet(self .salary@pre) τ)" 
                   apply(subst UML_Set.OclIncluding.cp0) apply(subst (2) UML_Set.OclIncluding.cp0)   
                   apply(subst (2) Analysis_UML.cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre)
                   apply(subst cp0_contents_at_pre)  apply(subst (2) cp0_contents_at_pre)
                   apply(subst (2) cp_dotPersonℬ𝒪𝒮𝒮_at_pre) by simp
           show "self res τ.
                   (res  if (self .boss@pre)  null then Set{self .salary@pre} 
                           else self .boss@pre .contents@pre()->includingSet(self .salary@pre) endif) τ =
                   ((λ_. res τ)  if (λ_. self τ) .boss@pre  null then Set{(λ_. self τ) .salary@pre} 
                                   else(λ_. self τ) .boss@pre .contents@pre()->includingSet((λ_. self τ) .salary@pre) endif) τ"
           apply(subst cp_StrongEq)
           apply(subst (2) cp_StrongEq)
           apply(subst cp_OclIf)
           apply(subst (2)cp_OclIf)
           by(simp add: A B C)
         qed
  
text‹Again, we derive via @{thm [source] contents.unfold2} a Knaster-Tarski like Fixpoint rule
that is amenable to symbolic evaluation:›
theorem unfold_contentsATpre :
   assumes "cp E"
   and     "τ  δ self"
   shows   "(τ  E (self .contents@pre())) = 
            (τ  E (if self .boss@pre  null 
                    then Set{self .salary@pre} 
                    else self .boss@pre .contents@pre()->includingSet(self .salary@pre) endif))"
by(rule contentsATpre.unfold2[of _ _ _ "λ X. true"], simp_all add: assms)

         
text‹Note that these \inlineocl{@pre} variants on methods are only available on queries, \ie,
operations without side-effect.›

section‹OCL Part: The Contract of a User-defined Method›
text‹
The example specification in high-level OCL input syntax reads as follows:
\begin{ocl}
context Person::insert(x:Integer)
pre: true
post: contents():Set(Integer)
contents() = contents@pre()->including(x)
\end{ocl}

This boils down to:
›

definition insert :: "Person Integer  Void"  ("(1(_).insert'(_'))" 50)
where "self .insert(x)  
            (λ τ. SOME res. let res = λ _. res in
                  if (τ  (δ self))   (τ  υ x)
                  then (τ  true   
                       (τ  ((self).contents()  (self).contents@pre()->includingSet(x))))
                  else τ  res  invalid)"  

text‹The semantic consequences of this definition were computed inside this locale interpretation:›
interpretation insert : contract1 "insert" "λ self x. true" 
                                  "λ self x res. ((self .contents())  
                                                       (self .contents@pre()->includingSet(x)))" 
         apply unfold_locales  apply(auto simp:insert_def)
         apply(subst cp_StrongEq) apply(subst (2) cp_StrongEq)
         apply(subst contents.cp0)
         apply(subst UML_Set.OclIncluding.cp0)
         apply(subst (2) UML_Set.OclIncluding.cp0)
         apply(subst contentsATpre.cp0)
         by(simp)  (* an extremely hacky proof that cries for reformulation and automation - bu *)

         
text‹The result of this locale interpretation for our @{term insert}  contract is the following 
set of properties, which serves as basis for automated deduction on them: 

\begin{table}[htbp]
   \centering
   \begin{tabu}{lX[,c,]}
      \toprule
      Name & Theorem \\
      \midrule
      @{thm [source] insert.strict0}  & @{thm  [display=false] insert.strict0} \\
      @{thm [source] insert.nullstrict0}  & @{thm  [display=false] insert.nullstrict0} \\
      @{thm [source] insert.strict1}  & @{thm  [display=false] insert.strict1} \\
      @{thm [source] insert.cpPRE}  & @{thm  [display=false] insert.cpPRE} \\
      @{thm [source] insert.cpPOST}  & @{thm  [display=false] insert.cpPOST} \\
      @{thm [source] insert.cp_pre}  & @{thm  [display=false] insert.cp_pre} \\
      @{thm [source] insert.cp_post}  & @{thm [display=false] insert.cp_post} \\
      @{thm [source] insert.cp}   & @{thm  [display=false] insert.cp} \\
      @{thm [source] insert.cp0}   & @{thm  [display=false] insert.cp0} \\   
      @{thm [source] insert.def_scheme}   & @{thm  [display=false] insert.def_scheme} \\
      @{thm [source] insert.unfold} & @{thm [display=false] insert.unfold} \\
      @{thm [source] insert.unfold2} & @{thm [display=false] insert.unfold2} \\
      \bottomrule
   \end{tabu}
   \caption{Semantic properties resulting from a user-defined operation contract.}
   \label{tab:sem_operation_contract}
\end{table}

›
         
end

Theory Design_UML

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * Design_UML.thy --- OCL Contracts and an Example.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

chapter‹Example: The Employee Design Model› (* UML part *)

theory
  Design_UML
imports
  "../../../UML_Main"
begin

text ‹\label{ex:employee-design:uml}›

section‹Introduction›
text‹
  For certain concepts like classes and class-types, only a generic
  definition for its resulting semantics can be given. Generic means,
  there is a function outside HOL that ``compiles'' a concrete,
  closed-world class diagram into a ``theory'' of this data model,
  consisting of a bunch of definitions for classes, accessors, method,
  casts, and tests for actual types, as well as proofs for the
  fundamental properties of these operations in this concrete data
  model.›

text‹Such generic function or ``compiler'' can be implemented in
  Isabelle on the ML level.  This has been done, for a semantics
  following the open-world assumption, for UML 2.0
  in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In
  this paper, we follow another approach for UML 2.4: we define the
  concepts of the compilation informally, and present a concrete
  example which is verified in Isabelle/HOL.›

subsection‹Outlining the Example›

text‹We are presenting here a ``design-model'' of the (slightly
modified) example Figure 7.3, page 20 of
the OCL standard~\cite{omg:ocl:2012}. To be precise, this theory contains the formalization of
the data-part covered by the UML class model (see \autoref{fig:person}):›

text‹
\begin{figure}
  \centering\scalebox{.3}{\includegraphics{figures/person.png}}%
  \caption{A simple UML class model drawn from Figure 7.3,
  page 20 of~\cite{omg:ocl:2012}. \label{fig:person}}
\end{figure}
›

text‹This means that the association (attached to the association class
\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented
by the attribute  \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the OCL part
captured by the subsequent theory).
›

section‹Example Data-Universe and its Infrastructure›
text‹Ideally, the following is generated automatically from a UML class model.›

text‹Our data universe  consists in the concrete class diagram just of node's,
and implicitly of the class object. Each class implies the existence of a class
type defined for the corresponding object representations as follows:›

datatype typePerson = mkPerson oid          (* the oid to the person itself *)
                            "int option" (* the attribute "salary" or null *)
                            "oid option" (* the attribute "boss" or null *)


datatype typeOclAny = mkOclAny oid          (* the oid to the oclany itself *)
                            "(int option × oid option) option"
                                         (* the extensions to "person"; used to denote
                                            objects of actual type "person" casted to "oclany";
                                            in case of existence of several subclasses
                                            of oclany, sums of extensions have to be provided. *)

text‹Now, we construct a concrete ``universe of OclAny types'' by injection into a
sum type containing the class types. This type of OclAny will be used as instance
for all respective type-variables.›

datatype 𝔄 = inPerson typePerson | inOclAny typeOclAny

text‹Having fixed the object universe, we can introduce type synonyms that exactly correspond
to OCL types. Again, we exploit that our representation of OCL is a ``shallow embedding'' with a
one-to-one correspondance of OCL-types to types of the meta-language HOL.›
type_synonym Boolean     = " 𝔄 Boolean"
type_synonym Integer     = " 𝔄 Integer"
type_synonym Void        = " 𝔄 Void"
type_synonym OclAny      = "(𝔄, typeOclAny option option) val"
type_synonym Person      = "(𝔄, typePerson option option) val"
type_synonym Set_Integer = "(𝔄, int option option) Set"
type_synonym Set_Person  = "(𝔄, typePerson option option) Set"

text‹Just a little check:›
typ "Boolean"

text‹To reuse key-elements of the library like referential equality, we have
to show that the object universe belongs to the type class ``oclany,'' \ie,
 each class type has to provide a function @{term oid_of} yielding the object id (oid) of the object.›
instantiation typePerson :: object
begin
   definition oid_of_typePerson_def: "oid_of x = (case x of mkPerson oid _ _  oid)"
   instance ..
end

instantiation typeOclAny :: object
begin
   definition oid_of_typeOclAny_def: "oid_of x = (case x of mkOclAny oid _  oid)"
   instance ..
end

instantiation 𝔄 :: object
begin
   definition oid_of_𝔄_def: "oid_of x = (case x of
                                             inPerson person  oid_of person
                                           | inOclAny oclany  oid_of oclany)"
   instance ..
end




section‹Instantiation of the Generic Strict Equality›
text‹We instantiate the referential equality
on Person› and OclAny›

overloading StrictRefEq  "StrictRefEq :: [Person,Person]  Boolean"
begin
  definition StrictRefEqObject_Person   : "(x::Person)  y   StrictRefEqObject x y"
end

overloading StrictRefEq  "StrictRefEq :: [OclAny,OclAny]  Boolean"
begin
  definition StrictRefEqObject_OclAny   : "(x::OclAny)  y   StrictRefEqObject x y"
end

lemmas cps23 = 
    cp_StrictRefEqObject[of "x::Person" "y::Person" "τ",
                         simplified StrictRefEqObject_Person[symmetric]]
    cp_intro(9)         [of "P::Person Person""Q::Person Person",
                         simplified StrictRefEqObject_Person[symmetric] ]
    StrictRefEqObject_def      [of "x::Person" "y::Person",
                         simplified StrictRefEqObject_Person[symmetric]]
    StrictRefEqObject_defargs  [of _ "x::Person" "y::Person",
                         simplified StrictRefEqObject_Person[symmetric]]
    StrictRefEqObject_strict1
                        [of "x::Person",
                         simplified StrictRefEqObject_Person[symmetric]]
    StrictRefEqObject_strict2
                        [of "x::Person",
                         simplified StrictRefEqObject_Person[symmetric]]
  for x y τ P Q
text‹For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)},
   a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form
   \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator.
›
text‹Thus, since we have two class-types in our concrete class hierarchy, we have
two operations to declare and to provide two overloading definitions for the two static types.
›


section‹OclAsType›
subsection‹Definition›

consts OclAsTypeOclAny :: "  OclAny" ("(_) .oclAsType'(OclAny')")
consts OclAsTypePerson :: "  Person" ("(_) .oclAsType'(Person')")

definition "OclAsTypeOclAny_𝔄 = (λu. case u of inOclAny a  a
                                            | inPerson (mkPerson oid a b)  mkOclAny oid (a,b))"

lemma OclAsTypeOclAny_𝔄_some: "OclAsTypeOclAny_𝔄 x  None"
by(simp add: OclAsTypeOclAny_𝔄_def)

overloading OclAsTypeOclAny  "OclAsTypeOclAny :: OclAny  OclAny"
begin
  definition OclAsTypeOclAny_OclAny:
        "(X::OclAny) .oclAsType(OclAny)  X"
end

overloading OclAsTypeOclAny  "OclAsTypeOclAny :: Person  OclAny"
begin
  definition OclAsTypeOclAny_Person:
        "(X::Person) .oclAsType(OclAny) 
                   (λτ. case X τ of
                                  invalid τ
                            |   null τ
                            | mkPerson oid a b      (mkOclAny oid (a,b)) )"
end

definition "OclAsTypePerson_𝔄 = 
                   (λu. case u of inPerson p  p
                            | inOclAny (mkOclAny oid (a,b))  mkPerson oid a b
                            | _  None)"

overloading OclAsTypePerson  "OclAsTypePerson :: OclAny  Person"
begin
  definition OclAsTypePerson_OclAny:
        "(X::OclAny) .oclAsType(Person) 
                   (λτ. case X τ of
                                  invalid τ
                            |   null τ
                            | mkOclAny oid     invalid τ   ― ‹down-cast exception›
                            | mkOclAny oid (a,b)    mkPerson oid a b )"
end

overloading OclAsTypePerson  "OclAsTypePerson :: Person  Person"
begin
  definition OclAsTypePerson_Person:
        "(X::Person) .oclAsType(Person)  X "  (* to avoid identity for null ? *)
end
text_raw‹\isatagafp›

lemmas [simp] =
 OclAsTypeOclAny_OclAny
 OclAsTypePerson_Person
subsection‹Context Passing›

lemma cp_OclAsTypeOclAny_Person_Person: "cp P  cp(λX. (P (X::Person)::Person) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsTypeOclAny_Person)
lemma cp_OclAsTypeOclAny_OclAny_OclAny: "cp P  cp(λX. (P (X::OclAny)::OclAny) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsTypeOclAny_OclAny)
lemma cp_OclAsTypePerson_Person_Person: "cp P  cp(λX. (P (X::Person)::Person) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsTypePerson_Person)
lemma cp_OclAsTypePerson_OclAny_OclAny: "cp P  cp(λX. (P (X::OclAny)::OclAny) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsTypePerson_OclAny)

lemma cp_OclAsTypeOclAny_Person_OclAny: "cp P  cp(λX. (P (X::Person)::OclAny) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsTypeOclAny_OclAny)
lemma cp_OclAsTypeOclAny_OclAny_Person: "cp P  cp(λX. (P (X::OclAny)::Person) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsTypeOclAny_Person)
lemma cp_OclAsTypePerson_Person_OclAny: "cp P  cp(λX. (P (X::Person)::OclAny) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsTypePerson_OclAny)
lemma cp_OclAsTypePerson_OclAny_Person: "cp P  cp(λX. (P (X::OclAny)::Person) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsTypePerson_Person)

lemmas [simp] =
 cp_OclAsTypeOclAny_Person_Person
 cp_OclAsTypeOclAny_OclAny_OclAny
 cp_OclAsTypePerson_Person_Person
 cp_OclAsTypePerson_OclAny_OclAny

 cp_OclAsTypeOclAny_Person_OclAny
 cp_OclAsTypeOclAny_OclAny_Person
 cp_OclAsTypePerson_Person_OclAny
 cp_OclAsTypePerson_OclAny_Person

text_raw‹\endisatagafp›

subsection‹Execution with Invalid or Null as Argument›

lemma OclAsTypeOclAny_OclAny_strict : "(invalid::OclAny) .oclAsType(OclAny) = invalid" by(simp)
lemma OclAsTypeOclAny_OclAny_nullstrict : "(null::OclAny) .oclAsType(OclAny) = null" by(simp)
lemma OclAsTypeOclAny_Person_strict[simp] : "(invalid::Person) .oclAsType(OclAny) = invalid"
      by(rule ext, simp add: bot_option_def invalid_def OclAsTypeOclAny_Person)
lemma OclAsTypeOclAny_Person_nullstrict[simp] : "(null::Person) .oclAsType(OclAny) = null"
      by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsTypeOclAny_Person)
lemma OclAsTypePerson_OclAny_strict[simp] : "(invalid::OclAny) .oclAsType(Person) = invalid"
      by(rule ext, simp add: bot_option_def invalid_def  OclAsTypePerson_OclAny)
lemma OclAsTypePerson_OclAny_nullstrict[simp] : "(null::OclAny) .oclAsType(Person) = null"
      by(rule ext, simp add: null_fun_def null_option_def bot_option_def  OclAsTypePerson_OclAny)
lemma OclAsTypePerson_Person_strict : "(invalid::Person) .oclAsType(Person) = invalid"  by(simp)
lemma OclAsTypePerson_Person_nullstrict : "(null::Person) .oclAsType(Person) = null" by(simp)

section‹OclIsTypeOf›

subsection‹Definition›

consts OclIsTypeOfOclAny :: "  Boolean" ("(_).oclIsTypeOf'(OclAny')")
consts OclIsTypeOfPerson :: "  Boolean" ("(_).oclIsTypeOf'(Person')")

overloading OclIsTypeOfOclAny  "OclIsTypeOfOclAny :: OclAny  Boolean"
begin
  definition OclIsTypeOfOclAny_OclAny:
        "(X::OclAny) .oclIsTypeOf(OclAny) 
                   (λτ. case X τ of
                                  invalid τ
                            |   true τ  ― ‹invalid ??›
                            | mkOclAny oid    true τ
                            | mkOclAny oid _   false τ)"
end

lemma OclIsTypeOfOclAny_OclAny':
         "(X::OclAny) .oclIsTypeOf(OclAny) = 
                    (λ τ. if τ  υ X then (case X τ of
                                                true τ  ― ‹invalid ??›
                                           | mkOclAny oid    true τ
                                           | mkOclAny oid _   false τ)
                                           else invalid τ)"
       apply(rule ext, simp add: OclIsTypeOfOclAny_OclAny)
       by(case_tac "τ  υ X", auto simp: foundation18' bot_option_def)

interpretation OclIsTypeOfOclAny_OclAny : 
       profile_mono_schemeV 
       "OclIsTypeOfOclAny::OclAny  Boolean" 
       "λ X. (case X of
                    None  True  ― ‹invalid ??›
                  | mkOclAny oid None   True
                  | mkOclAny oid _   False)"                     
      apply(unfold_locales, simp add: atomize_eq, rule ext)
      by(auto simp:  OclIsTypeOfOclAny_OclAny' OclValid_def true_def false_def 
              split: option.split typeOclAny.split)

overloading OclIsTypeOfOclAny  "OclIsTypeOfOclAny :: Person  Boolean"
begin
  definition OclIsTypeOfOclAny_Person:
        "(X::Person) .oclIsTypeOf(OclAny) 
                   (λτ. case X τ of
                                  invalid τ
                            |   true τ    ― ‹invalid ??›
                            |  _   false τ)  ― ‹must have actual type Person› otherwise›"
end

overloading OclIsTypeOfPerson  "OclIsTypeOfPerson :: OclAny  Boolean"
begin
  definition OclIsTypeOfPerson_OclAny:
        "(X::OclAny) .oclIsTypeOf(Person) 
                   (λτ. case X τ of
                                  invalid τ
                            |   true τ
                            | mkOclAny oid    false τ
                            | mkOclAny oid _   true τ)"
end

overloading OclIsTypeOfPerson  "OclIsTypeOfPerson :: Person  Boolean"
begin
  definition OclIsTypeOfPerson_Person:
        "(X::Person) .oclIsTypeOf(Person) 
                   (λτ. case X τ of
                                invalid τ
                            | _  true τ)" (* for (* ⌊⌊ _ ⌋⌋ ⇒ true τ *) : must have actual type Node otherwise  *)
end
text_raw‹\isatagafp›
subsection‹Context Passing›

lemma cp_OclIsTypeOfOclAny_Person_Person: "cp P  cp(λX.(P(X::Person)::Person).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOfOclAny_Person)
lemma cp_OclIsTypeOfOclAny_OclAny_OclAny: "cp P  cp(λX.(P(X::OclAny)::OclAny).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOfOclAny_OclAny)
lemma cp_OclIsTypeOfPerson_Person_Person: "cp P  cp(λX.(P(X::Person)::Person).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOfPerson_Person)
lemma cp_OclIsTypeOfPerson_OclAny_OclAny: "cp P  cp(λX.(P(X::OclAny)::OclAny).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOfPerson_OclAny)


lemma cp_OclIsTypeOfOclAny_Person_OclAny: "cp P  cp(λX.(P(X::Person)::OclAny).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOfOclAny_OclAny)
lemma cp_OclIsTypeOfOclAny_OclAny_Person: "cp P  cp(λX.(P(X::OclAny)::Person).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOfOclAny_Person)
lemma cp_OclIsTypeOfPerson_Person_OclAny: "cp P  cp(λX.(P(X::Person)::OclAny).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOfPerson_OclAny)
lemma cp_OclIsTypeOfPerson_OclAny_Person: "cp P  cp(λX.(P(X::OclAny)::Person).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOfPerson_Person)

lemmas [simp] =
 cp_OclIsTypeOfOclAny_Person_Person
 cp_OclIsTypeOfOclAny_OclAny_OclAny
 cp_OclIsTypeOfPerson_Person_Person
 cp_OclIsTypeOfPerson_OclAny_OclAny

 cp_OclIsTypeOfOclAny_Person_OclAny
 cp_OclIsTypeOfOclAny_OclAny_Person
 cp_OclIsTypeOfPerson_Person_OclAny
 cp_OclIsTypeOfPerson_OclAny_Person
text_raw‹\endisatagafp›

subsection‹Execution with Invalid or Null as Argument›

lemma OclIsTypeOfOclAny_OclAny_strict1[simp]:
     "(invalid::OclAny) .oclIsTypeOf(OclAny) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfOclAny_OclAny)
lemma OclIsTypeOfOclAny_OclAny_strict2[simp]:
     "(null::OclAny) .oclIsTypeOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfOclAny_OclAny)
lemma OclIsTypeOfOclAny_Person_strict1[simp]:
     "(invalid::Person) .oclIsTypeOf(OclAny) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfOclAny_Person)
lemma OclIsTypeOfOclAny_Person_strict2[simp]:
     "(null::Person) .oclIsTypeOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfOclAny_Person)
lemma OclIsTypeOfPerson_OclAny_strict1[simp]:
     "(invalid::OclAny) .oclIsTypeOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfPerson_OclAny)
lemma OclIsTypeOfPerson_OclAny_strict2[simp]:
     "(null::OclAny) .oclIsTypeOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfPerson_OclAny)
lemma OclIsTypeOfPerson_Person_strict1[simp]:
     "(invalid::Person) .oclIsTypeOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfPerson_Person)
lemma OclIsTypeOfPerson_Person_strict2[simp]:
     "(null::Person) .oclIsTypeOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsTypeOfPerson_Person)

subsection‹Up Down Casting›

lemma actualType_larger_staticType:
assumes isdef: "τ  (δ X)"
shows          "τ  (X::Person) .oclIsTypeOf(OclAny)  false"
using isdef
by(auto simp : null_option_def bot_option_def
               OclIsTypeOfOclAny_Person foundation22 foundation16)

lemma down_cast_type:
assumes isOclAny: "τ  (X::OclAny) .oclIsTypeOf(OclAny)"
and     non_null: "τ  (δ X)"
shows             "τ  (X .oclAsType(Person))  invalid"
using isOclAny non_null
apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
                  OclAsTypeOclAny_Person OclAsTypePerson_OclAny foundation22 foundation16
           split: option.split typeOclAny.split typePerson.split)
by(simp add: OclIsTypeOfOclAny_OclAny  OclValid_def false_def true_def)

lemma down_cast_type':
assumes isOclAny: "τ  (X::OclAny) .oclIsTypeOf(OclAny)"
and     non_null: "τ  (δ X)"
shows             "τ  not (υ (X .oclAsType(Person)))"
by(rule foundation15[THEN iffD1], simp add: down_cast_type[OF assms])

lemma up_down_cast :
assumes isdef: "τ  (δ X)"
shows "τ  ((X::Person) .oclAsType(OclAny) .oclAsType(Person)  X)"
using isdef
by(auto simp : null_fun_def null_option_def bot_option_def null_def invalid_def
               OclAsTypeOclAny_Person OclAsTypePerson_OclAny foundation22 foundation16
        split: option.split typePerson.split)


lemma up_down_cast_Person_OclAny_Person [simp]:
shows "((X::Person) .oclAsType(OclAny) .oclAsType(Person) = X)"
 apply(rule ext, rename_tac τ)
 apply(rule foundation22[THEN iffD1])
 apply(case_tac "τ  (δ X)", simp add: up_down_cast)
 apply(simp add: defined_split, elim disjE)
 apply(erule StrongEq_L_subst2_rev, simp, simp)+
done

lemma up_down_cast_Person_OclAny_Person':
assumes "τ  υ X"
shows   "τ  (((X :: Person) .oclAsType(OclAny) .oclAsType(Person))  X)"
 apply(simp only: up_down_cast_Person_OclAny_Person StrictRefEqObject_Person)
by(rule StrictRefEqObject_sym, simp add: assms)

lemma up_down_cast_Person_OclAny_Person'': 
assumes "τ  υ (X :: Person)"
shows   "τ  (X .oclIsTypeOf(Person) implies (X .oclAsType(OclAny) .oclAsType(Person))  X)"
 apply(simp add: OclValid_def)
 apply(subst cp_OclImplies)
 apply(simp add: StrictRefEqObject_Person StrictRefEqObject_sym[OF assms, simplified OclValid_def])
 apply(subst cp_OclImplies[symmetric])
by simp


section‹OclIsKindOf›
subsection‹Definition›

consts OclIsKindOfOclAny :: "  Boolean" ("(_).oclIsKindOf'(OclAny')")
consts OclIsKindOfPerson :: "  Boolean" ("(_).oclIsKindOf'(Person')")

overloading OclIsKindOfOclAny  "OclIsKindOfOclAny :: OclAny  Boolean"
begin
  definition OclIsKindOfOclAny_OclAny:
        "(X::OclAny) .oclIsKindOf(OclAny) 
                   (λτ. case X τ of
                                invalid τ
                            | _  true τ)"
end

overloading OclIsKindOfOclAny  "OclIsKindOfOclAny :: Person  Boolean"
begin
  definition OclIsKindOfOclAny_Person:
        "(X::Person) .oclIsKindOf(OclAny) 
                   (λτ. case X τ of
                                invalid τ
                            | _ true τ)"
(* for (* ⌊⌊mkPerson e oid _ ⌋⌋ ⇒ true τ *) :  must have actual type Person otherwise  *)
end

overloading OclIsKindOfPerson  "OclIsKindOfPerson :: OclAny  Boolean"
begin
  definition OclIsKindOfPerson_OclAny:
        "(X::OclAny) .oclIsKindOf(Person) 
                   (λτ. case X τ of
                                  invalid τ
                            |   true τ
                            | mkOclAny oid    false τ
                            | mkOclAny oid _   true τ)"
end

overloading OclIsKindOfPerson  "OclIsKindOfPerson :: Person  Boolean"
begin
 definition OclIsKindOfPerson_Person:
        "(X::Person) .oclIsKindOf(Person) 
                   (λτ. case X τ of
                                invalid τ
                            | _  true τ)"
end
text_raw‹\isatagafp›
subsection‹Context Passing›

lemma cp_OclIsKindOfOclAny_Person_Person: "cp P  cp(λX.(P(X::Person)::Person).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOfOclAny_Person)
lemma cp_OclIsKindOfOclAny_OclAny_OclAny: "cp P  cp(λX.(P(X::OclAny)::OclAny).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOfOclAny_OclAny)
lemma cp_OclIsKindOfPerson_Person_Person: "cp P  cp(λX.(P(X::Person)::Person).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOfPerson_Person)
lemma cp_OclIsKindOfPerson_OclAny_OclAny: "cp P  cp(λX.(P(X::OclAny)::OclAny).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOfPerson_OclAny)

lemma cp_OclIsKindOfOclAny_Person_OclAny: "cp P  cp(λX.(P(X::Person)::OclAny).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOfOclAny_OclAny)
lemma cp_OclIsKindOfOclAny_OclAny_Person: "cp P  cp(λX.(P(X::OclAny)::Person).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOfOclAny_Person)
lemma cp_OclIsKindOfPerson_Person_OclAny: "cp P  cp(λX.(P(X::Person)::OclAny).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOfPerson_OclAny)
lemma cp_OclIsKindOfPerson_OclAny_Person: "cp P  cp(λX.(P(X::OclAny)::Person).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOfPerson_Person)

lemmas [simp] =
 cp_OclIsKindOfOclAny_Person_Person
 cp_OclIsKindOfOclAny_OclAny_OclAny
 cp_OclIsKindOfPerson_Person_Person
 cp_OclIsKindOfPerson_OclAny_OclAny

 cp_OclIsKindOfOclAny_Person_OclAny
 cp_OclIsKindOfOclAny_OclAny_Person
 cp_OclIsKindOfPerson_Person_OclAny
 cp_OclIsKindOfPerson_OclAny_Person
text_raw‹\endisatagafp›
subsection‹Execution with Invalid or Null as Argument›

lemma OclIsKindOfOclAny_OclAny_strict1[simp] : "(invalid::OclAny) .oclIsKindOf(OclAny) = invalid"
by(rule ext, simp add: invalid_def bot_option_def
                       OclIsKindOfOclAny_OclAny)
lemma OclIsKindOfOclAny_OclAny_strict2[simp] : "(null::OclAny) .oclIsKindOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def
                       OclIsKindOfOclAny_OclAny)
lemma OclIsKindOfOclAny_Person_strict1[simp] : "(invalid::Person) .oclIsKindOf(OclAny) = invalid"
by(rule ext, simp add: bot_option_def invalid_def
                       OclIsKindOfOclAny_Person)
lemma OclIsKindOfOclAny_Person_strict2[simp] : "(null::Person) .oclIsKindOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def
                       OclIsKindOfOclAny_Person)
lemma OclIsKindOfPerson_OclAny_strict1[simp]: "(invalid::OclAny) .oclIsKindOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsKindOfPerson_OclAny)
lemma OclIsKindOfPerson_OclAny_strict2[simp]: "(null::OclAny) .oclIsKindOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsKindOfPerson_OclAny)
lemma OclIsKindOfPerson_Person_strict1[simp]: "(invalid::Person) .oclIsKindOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsKindOfPerson_Person)
lemma OclIsKindOfPerson_Person_strict2[simp]: "(null::Person) .oclIsKindOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                       OclIsKindOfPerson_Person)

subsection‹Up Down Casting›

lemma actualKind_larger_staticKind:
assumes isdef: "τ  (δ X)"
shows          "τ   ((X::Person) .oclIsKindOf(OclAny)  true)"
using isdef
by(auto simp : bot_option_def
               OclIsKindOfOclAny_Person foundation22 foundation16)

lemma down_cast_kind:
assumes isOclAny: "¬ (τ  ((X::OclAny).oclIsKindOf(Person)))"
and     non_null: "τ  (δ X)"
shows             "τ  ((X .oclAsType(Person))  invalid)"
using isOclAny non_null
apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
                  OclAsTypeOclAny_Person OclAsTypePerson_OclAny foundation22 foundation16
           split: option.split typeOclAny.split typePerson.split)
by(simp add: OclIsKindOfPerson_OclAny  OclValid_def false_def true_def)

section‹OclAllInstances›

text‹To denote OCL-types occurring in OCL expressions syntactically---as, for example,  as
``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
functions into the object universes; we show that this is sufficient ``characterization.''›

definition "Person  OclAsTypePerson_𝔄"
definition "OclAny  OclAsTypeOclAny_𝔄"
lemmas [simp] = Person_def OclAny_def

lemma OclAllInstances_genericOclAny_exec: "OclAllInstances_generic pre_post OclAny =
             (λτ.  Abs_Setbase   Some ` OclAny ` ran (heap (pre_post τ)) )"
proof -
 let ?S1 = "λτ. OclAny ` ran (heap (pre_post τ))"
 let ?S2 = "λτ. ?S1 τ - {None}"
 have B : "τ. ?S2 τ  ?S1 τ" by auto
 have C : "τ. ?S1 τ  ?S2 τ" by(auto simp: OclAsTypeOclAny_𝔄_some)

 show ?thesis by(insert equalityI[OF B C], simp)
qed

lemma OclAllInstances_at_postOclAny_exec: "OclAny .allInstances() =
             (λτ.  Abs_Setbase   Some ` OclAny ` ran (heap (snd τ)) )"
unfolding OclAllInstances_at_post_def
by(rule OclAllInstances_genericOclAny_exec)

lemma OclAllInstances_at_preOclAny_exec: "OclAny .allInstances@pre() =
             (λτ.  Abs_Setbase   Some ` OclAny ` ran (heap (fst τ)) ) "
unfolding OclAllInstances_at_pre_def
by(rule OclAllInstances_genericOclAny_exec)

subsection‹OclIsTypeOf›

lemma OclAny_allInstances_generic_oclIsTypeOfOclAny1:
assumes [simp]: "x. pre_post (x, x) = x"
shows "τ. (τ      ((OclAllInstances_generic pre_post OclAny)->forAllSet(X|X .oclIsTypeOf(OclAny))))"
 apply(rule_tac x = τ0 in exI, simp add: τ0_def OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: assms UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
by(simp add: OclIsTypeOfOclAny_OclAny)

lemma OclAny_allInstances_at_post_oclIsTypeOfOclAny1:
"τ. (τ      (OclAny .allInstances()->forAllSet(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsTypeOfOclAny1, simp)

lemma OclAny_allInstances_at_pre_oclIsTypeOfOclAny1:
"τ. (τ      (OclAny .allInstances@pre()->forAllSet(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsTypeOfOclAny1, simp)

lemma OclAny_allInstances_generic_oclIsTypeOfOclAny2:
assumes [simp]: "x. pre_post (x, x) = x"
shows "τ. (τ  not ((OclAllInstances_generic pre_post OclAny)->forAllSet(X|X .oclIsTypeOf(OclAny))))"
proof - fix oid a let ?t0 = "heap = Map.empty(oid  inOclAny (mkOclAny oid a)),
                              assocs = Map.empty" show ?thesis
 apply(rule_tac x = "(?t0, ?t0)" in exI, simp add: OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def OclAsTypeOclAny_𝔄_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
 by(simp add: OclIsTypeOfOclAny_OclAny OclNot_def OclAny_def)
qed

lemma OclAny_allInstances_at_post_oclIsTypeOfOclAny2:
"τ. (τ  not (OclAny .allInstances()->forAllSet(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsTypeOfOclAny2, simp)

lemma OclAny_allInstances_at_pre_oclIsTypeOfOclAny2:
"τ. (τ  not (OclAny .allInstances@pre()->forAllSet(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsTypeOfOclAny2, simp)

lemma Person_allInstances_generic_oclIsTypeOfPerson:
"τ  ((OclAllInstances_generic pre_post Person)->forAllSet(X|X .oclIsTypeOf(Person)))"
 apply(simp add: OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
by(simp add: OclIsTypeOfPerson_Person)

lemma Person_allInstances_at_post_oclIsTypeOfPerson:
"τ  (Person .allInstances()->forAllSet(X|X .oclIsTypeOf(Person)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsTypeOfPerson)

lemma Person_allInstances_at_pre_oclIsTypeOfPerson:
"τ  (Person .allInstances@pre()->forAllSet(X|X .oclIsTypeOf(Person)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsTypeOfPerson)

subsection‹OclIsKindOf›
lemma OclAny_allInstances_generic_oclIsKindOfOclAny:
"τ  ((OclAllInstances_generic pre_post OclAny)->forAllSet(X|X .oclIsKindOf(OclAny)))"
 apply(simp add: OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOfOclAny_OclAny)

lemma OclAny_allInstances_at_post_oclIsKindOfOclAny:
"τ  (OclAny .allInstances()->forAllSet(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsKindOfOclAny)

lemma OclAny_allInstances_at_pre_oclIsKindOfOclAny:
"τ  (OclAny .allInstances@pre()->forAllSet(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsKindOfOclAny)

lemma Person_allInstances_generic_oclIsKindOfOclAny:
"τ  ((OclAllInstances_generic pre_post Person)->forAllSet(X|X .oclIsKindOf(OclAny)))"
 apply(simp add: OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOfOclAny_Person)

lemma Person_allInstances_at_post_oclIsKindOfOclAny:
"τ  (Person .allInstances()->forAllSet(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsKindOfOclAny)

lemma Person_allInstances_at_pre_oclIsKindOfOclAny:
"τ  (Person .allInstances@pre()->forAllSet(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsKindOfOclAny)

lemma Person_allInstances_generic_oclIsKindOfPerson:
"τ  ((OclAllInstances_generic pre_post Person)->forAllSet(X|X .oclIsKindOf(Person)))"
 apply(simp add: OclValid_def del: OclAllInstances_generic_def)
 apply(simp only: UML_Set.OclForall_def refl if_True
                  OclAllInstances_generic_defined[simplified OclValid_def])
 apply(simp only: OclAllInstances_generic_def)
 apply(subst (1 2 3) Abs_Setbase_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOfPerson_Person)

lemma Person_allInstances_at_post_oclIsKindOfPerson:
"τ  (Person .allInstances()->forAllSet(X|X .oclIsKindOf(Person)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsKindOfPerson)

lemma Person_allInstances_at_pre_oclIsKindOfPerson:
"τ  (Person .allInstances@pre()->forAllSet(X|X .oclIsKindOf(Person)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsKindOfPerson)

section‹The Accessors (any, boss, salary)›
text‹\label{sec:edm-accessors}›
text‹Should be generated entirely from a class-diagram.›


subsection‹Definition›

definition eval_extract :: "('𝔄,('a::object) option option) val
                             (oid  ('𝔄,'c::null) val)
                             ('𝔄,'c::null) val"
where "eval_extract X f = (λ τ. case X τ of
                                      invalid τ   ― ‹exception propagation›
                               |      invalid τ ― ‹dereferencing null pointer›
                               |  obj   f (oid_of obj) τ)"


definition deref_oidPerson :: "(𝔄 state × 𝔄 state  𝔄 state)
                              (typePerson  (𝔄, 'c::null)val)
                              oid
                              (𝔄, 'c::null)val"
where "deref_oidPerson fst_snd f oid = (λτ. case (heap (fst_snd τ)) oid of
                                               inPerson obj   f obj τ
                                            | _               invalid τ)"



definition deref_oidOclAny :: "(𝔄 state × 𝔄 state  𝔄 state)
                              (typeOclAny  (𝔄, 'c::null)val)
                              oid
                              (𝔄, 'c::null)val"
where "deref_oidOclAny fst_snd f oid = (λτ. case (heap (fst_snd τ)) oid of
                        inOclAny obj   f obj τ
                     | _        invalid τ)"

text‹pointer undefined in state or not referencing a type conform object representation›


definition "selectOclAny𝒜𝒩𝒴 f = (λ X. case X of
                     (mkOclAny _ )  null
                   | (mkOclAny _ any)  f (λx _. x) any)"


definition "selectPersonℬ𝒪𝒮𝒮 f = (λ X. case X of
                     (mkPerson _ _ )  null  ― ‹object contains null pointer›
                   | (mkPerson _ _ boss)  f (λx _. x) boss)"


definition "selectPerson𝒮𝒜ℒ𝒜ℛ𝒴 f = (λ X. case X of
                     (mkPerson _  _)  null
                   | (mkPerson _ salary _)  f (λx _. x) salary)"


definition "in_pre_state = fst"
definition "in_post_state = snd"

definition "reconst_basetype = (λ convert x. convert x)"

definition dotOclAny𝒜𝒩𝒴 :: "OclAny  _"  ("(1(_).any)" 50)
  where "(X).any = eval_extract X
                     (deref_oidOclAny in_post_state
                       (selectOclAny𝒜𝒩𝒴
                         reconst_basetype))"

definition dotPersonℬ𝒪𝒮𝒮 :: "Person  Person"  ("(1(_).boss)" 50)
  where "(X).boss = eval_extract X
                      (deref_oidPerson in_post_state
                        (selectPersonℬ𝒪𝒮𝒮
                          (deref_oidPerson in_post_state)))"

definition dotPerson𝒮𝒜ℒ𝒜ℛ𝒴 :: "Person  Integer"  ("(1(_).salary)" 50)
  where "(X).salary = eval_extract X
                        (deref_oidPerson in_post_state
                          (selectPerson𝒮𝒜ℒ𝒜ℛ𝒴
                            reconst_basetype))"

definition dotOclAny𝒜𝒩𝒴_at_pre :: "OclAny  _"  ("(1(_).any@pre)" 50)
  where "(X).any@pre = eval_extract X
                         (deref_oidOclAny in_pre_state
                           (selectOclAny𝒜𝒩𝒴
                             reconst_basetype))"

definition dotPersonℬ𝒪𝒮𝒮_at_pre:: "Person  Person"  ("(1(_).boss@pre)" 50)
  where "(X).boss@pre = eval_extract X
                          (deref_oidPerson in_pre_state
                            (selectPersonℬ𝒪𝒮𝒮
                              (deref_oidPerson in_pre_state)))"

definition dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre:: "Person  Integer"  ("(1(_).salary@pre)" 50)
  where "(X).salary@pre = eval_extract X
                            (deref_oidPerson in_pre_state
                              (selectPerson𝒮𝒜ℒ𝒜ℛ𝒴
                                reconst_basetype))"

lemmas dot_accessor =
  dotOclAny𝒜𝒩𝒴_def
  dotPersonℬ𝒪𝒮𝒮_def
  dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_def
  dotOclAny𝒜𝒩𝒴_at_pre_def
  dotPersonℬ𝒪𝒮𝒮_at_pre_def
  dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_def

subsection‹Context Passing›

lemmas [simp] = eval_extract_def

lemma cp_dotOclAny𝒜𝒩𝒴: "((X).any) τ = ((λ_. X τ).any) τ" by (simp add: dot_accessor)
lemma cp_dotPersonℬ𝒪𝒮𝒮: "((X).boss) τ = ((λ_. X τ).boss) τ" by (simp add: dot_accessor)
lemma cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴: "((X).salary) τ = ((λ_. X τ).salary) τ" by (simp add: dot_accessor)

lemma cp_dotOclAny𝒜𝒩𝒴_at_pre: "((X).any@pre) τ = ((λ_. X τ).any@pre) τ" by (simp add: dot_accessor)
lemma cp_dotPersonℬ𝒪𝒮𝒮_at_pre: "((X).boss@pre) τ = ((λ_. X τ).boss@pre) τ" by (simp add: dot_accessor)
lemma cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre: "((X).salary@pre) τ = ((λ_. X τ).salary@pre) τ" by (simp add: dot_accessor)

lemmas cp_dotOclAny𝒜𝒩𝒴_I [simp, intro!]=
       cp_dotOclAny𝒜𝒩𝒴[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dotOclAny𝒜𝒩𝒴_at_pre_I [simp, intro!]=
       cp_dotOclAny𝒜𝒩𝒴_at_pre[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]

lemmas cp_dotPersonℬ𝒪𝒮𝒮_I [simp, intro!]=
       cp_dotPersonℬ𝒪𝒮𝒮[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dotPersonℬ𝒪𝒮𝒮_at_pre_I [simp, intro!]=
       cp_dotPersonℬ𝒪𝒮𝒮_at_pre[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]

lemmas cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_I [simp, intro!]=
       cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_I [simp, intro!]=
       cp_dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre[THEN allI[THEN allI],
                          of "λ X _. X" "λ _ τ. τ", THEN cpI1]

subsection‹Execution with Invalid or Null as Argument›

lemma dotOclAny𝒜𝒩𝒴_nullstrict [simp]: "(null).any = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotOclAny𝒜𝒩𝒴_at_pre_nullstrict [simp] : "(null).any@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotOclAny𝒜𝒩𝒴_strict [simp] : "(invalid).any = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotOclAny𝒜𝒩𝒴_at_pre_strict [simp] : "(invalid).any@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)


lemma dotPersonℬ𝒪𝒮𝒮_nullstrict [simp]: "(null).boss = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPersonℬ𝒪𝒮𝒮_at_pre_nullstrict [simp] : "(null).boss@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPersonℬ𝒪𝒮𝒮_strict [simp] : "(invalid).boss = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPersonℬ𝒪𝒮𝒮_at_pre_strict [simp] : "(invalid).boss@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)


lemma dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_nullstrict [simp]: "(null).salary = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_nullstrict [simp] : "(null).salary@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_strict [simp] : "(invalid).salary = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dotPerson𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_strict [simp] : "(invalid).salary@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)

subsection‹Representation in States›

lemma dotPersonℬ𝒪𝒮𝒮_def_mono:"τ  δ(X .boss)  τ  δ(X)"
  apply(case_tac "τ  (X  invalid)", insert StrongEq_L_subst2[where P = "(λx. (δ (x .boss)))" and τ = "τ" and x = "X" and y = "invalid"], simp add: foundation16')
  apply(case_tac "τ  (X  null)", insert StrongEq_L_subst2[where P = "(λx. (δ (x .boss)))" and τ = "τ" and x = "X" and y = "null"], simp add: foundation16')
by(simp add: defined_split)

lemma repr_boss:  
assumes A : "τ  δ(x .boss)"
shows      "is_represented_in_state in_post_state (x .boss) Person τ"
         apply(insert A[simplified foundation16]
                      A[THEN dotPersonℬ𝒪𝒮𝒮_def_mono, simplified foundation16])
         unfolding is_represented_in_state_def
                   dotPersonℬ𝒪𝒮𝒮_def eval_extract_def selectPersonℬ𝒪𝒮𝒮_def in_post_state_def
         by(auto simp: deref_oidPerson_def bot_fun_def bot_option_def null_option_def null_fun_def invalid_def
                       OclAsTypePerson_𝔄_def image_def ran_def
                 split: typePerson.split option.split 𝔄.split)

lemma repr_bossX : 
assumes A: "τ  δ(x .boss)"
shows "τ  ((Person .allInstances()) ->includesSet(x .boss))"
proof -
  have B : "S f. (x .boss) τ  (Some ` f ` S) 
                  (x .boss) τ  (Some ` (f ` S - {None}))"
            apply(auto simp: image_def ran_def, metis)
  by(insert A[simplified foundation16], simp add: null_option_def bot_option_def)
  show ?thesis
         apply(insert repr_boss[OF A] OclAllInstances_at_post_defined[where H = Person and τ = τ])
         unfolding is_represented_in_state_def OclValid_def
                   OclAllInstances_at_post_def OclAllInstances_generic_def OclIncludes_def
                   in_post_state_def
         apply(simp add: A[THEN foundation20, simplified OclValid_def])
         apply(subst Abs_Setbase_inverse, simp, metis bot_option_def option.distinct(1))
  by(simp add: image_comp B true_def)
qed

section‹A Little Infra-structure on Example States›

text‹
The example we are defining in this section comes from the figure~\ref{fig:edm1_system-states}.
\begin{figure}
\includegraphics[width=\textwidth]{figures/pre-post.pdf}
\caption{(a) pre-state $\sigma_1$ and
  (b) post-state $\sigma_1'$.}
\label{fig:edm1_system-states}
\end{figure}
›

text_raw‹\isatagafp›

definition OclInt1000 ("𝟭𝟬𝟬𝟬") where "OclInt1000 = (λ _ . 1000)"
definition OclInt1200 ("𝟭𝟮𝟬𝟬") where "OclInt1200 = (λ _ . 1200)"
definition OclInt1300 ("𝟭𝟯𝟬𝟬") where "OclInt1300 = (λ _ . 1300)"
definition OclInt1800 ("𝟭𝟴𝟬𝟬") where "OclInt1800 = (λ _ . 1800)"
definition OclInt2600 ("𝟮𝟲𝟬𝟬") where "OclInt2600 = (λ _ . 2600)"
definition OclInt2900 ("𝟮𝟵𝟬𝟬") where "OclInt2900 = (λ _ . 2900)"
definition OclInt3200 ("𝟯𝟮𝟬𝟬") where "OclInt3200 = (λ _ . 3200)"
definition OclInt3500 ("𝟯𝟱𝟬𝟬") where "OclInt3500 = (λ _ . 3500)"

definition "oid0  0"
definition "oid1  1"
definition "oid2  2"
definition "oid3  3"
definition "oid4  4"
definition "oid5  5"
definition "oid6  6"
definition "oid7  7"
definition "oid8  8"

definition "person1  mkPerson oid0 1300 oid1"
definition "person2  mkPerson oid1 1800 oid1"
definition "person3  mkPerson oid2 None None"
definition "person4  mkPerson oid3 2900 None"
definition "person5  mkPerson oid4 3500 None"
definition "person6  mkPerson oid5 2500 oid6"
definition "person7  mkOclAny oid6 (3200, oid6)"
definition "person8  mkOclAny oid7 None"
definition "person9  mkPerson oid8 0 None"

definition
      "σ1    heap = Map.empty(oid0  inPerson (mkPerson oid0 1000 oid1))
                           (oid1  inPerson (mkPerson oid1 1200  None))
                           ⌦‹oid2›
                           (oid3  inPerson (mkPerson oid3 2600 oid4))
                           (oid4  inPerson person5)
                           (oid5  inPerson (mkPerson oid5 2300 oid3))
                           ⌦‹oid6›
                           ⌦‹oid7›
                           (oid8  inPerson person9),
               assocs = Map.empty "

definition
      "σ1'   heap = Map.empty(oid0  inPerson person1)
                           (oid1  inPerson person2)
                           (oid2  inPerson person3)
                           (oid3  inPerson person4)
                           ⌦‹oid4›
                           (oid5  inPerson person6)
                           (oid6  inOclAny person7)
                           (oid7  inOclAny person8)
                           (oid8  inPerson person9),
               assocs = Map.empty "

definition "σ0   heap = Map.empty, assocs = Map.empty "


lemma basic_τ_wff: "WFF(σ1,σ1')"
by(auto simp: WFF_def σ1_def σ1'_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
              oid_of_𝔄_def oid_of_typePerson_def oid_of_typeOclAny_def
              person1_def person2_def person3_def person4_def
              person5_def person6_def person7_def person8_def person9_def)

lemma [simp,code_unfold]: "dom (heap σ1) = {oid0,oid1⌦‹,oid2›,oid3,oid4,oid5⌦‹,oid6,oid7›,oid8}"
by(auto simp: σ1_def)

lemma [simp,code_unfold]: "dom (heap σ1') = {oid0,oid1,oid2,oid3⌦‹,oid4›,oid5,oid6,oid7,oid8}"
by(auto simp: σ1'_def)

text_raw‹\isatagafp›

definition "XPerson1 :: Person  λ _ . person1 "
definition "XPerson2 :: Person  λ _ . person2 "
definition "XPerson3 :: Person  λ _ . person3 "
definition "XPerson4 :: Person  λ _ . person4 "
definition "XPerson5 :: Person  λ _ . person5 "
definition "XPerson6 :: Person  λ _ . person6 "
definition "XPerson7 :: OclAny  λ _ . person7 "
definition "XPerson8 :: OclAny  λ _ . person8 "
definition "XPerson9 :: Person  λ _ . person9 "

lemma [code_unfold]: "((x::Person)  y) = StrictRefEqObject x y" by(simp only: StrictRefEqObject_Person)
lemma [code_unfold]: "((x::OclAny)  y) = StrictRefEqObject x y" by(simp only: StrictRefEqObject_OclAny)

lemmas [simp,code_unfold] =
 OclAsTypeOclAny_OclAny
 OclAsTypeOclAny_Person
 OclAsTypePerson_OclAny
 OclAsTypePerson_Person

 OclIsTypeOfOclAny_OclAny
 OclIsTypeOfOclAny_Person
 OclIsTypeOfPerson_OclAny
 OclIsTypeOfPerson_Person

 OclIsKindOfOclAny_OclAny
 OclIsKindOfOclAny_Person
 OclIsKindOfPerson_OclAny
 OclIsKindOfPerson_Person
text_raw‹\endisatagafp›

Assert "spre     .   (spre,σ1')       (XPerson1 .salary    <> 𝟭𝟬𝟬𝟬)"
Assert "spre     .   (spre,σ1')       (XPerson1 .salary     𝟭𝟯𝟬𝟬)"
Assert "    spost.   (σ1,spost)       (XPerson1 .salary@pre      𝟭𝟬𝟬𝟬)"
Assert "    spost.   (σ1,spost)       (XPerson1 .salary@pre     <> 𝟭𝟯𝟬𝟬)"
Assert "spre     .   (spre,σ1')       (XPerson1 .boss   <> XPerson1)"
Assert "spre     .   (spre,σ1')       (XPerson1 .boss .salary    𝟭𝟴𝟬𝟬)"
Assert "spre     .   (spre,σ1')       (XPerson1 .boss .boss  <> XPerson1)"
Assert "spre     .   (spre,σ1')       (XPerson1 .boss .boss   XPerson2)"
Assert "               (σ1,σ1')       (XPerson1 .boss@pre .salary   𝟭𝟴𝟬𝟬)"
Assert "    spost.   (σ1,spost)       (XPerson1 .boss@pre .salary@pre   𝟭𝟮𝟬𝟬)"
Assert "    spost.   (σ1,spost)       (XPerson1 .boss@pre .salary@pre  <> 𝟭𝟴𝟬𝟬)"
Assert "    spost.   (σ1,spost)       (XPerson1 .boss@pre   XPerson2)"
Assert "               (σ1,σ1')       (XPerson1 .boss@pre .boss   XPerson2)"
Assert "    spost.   (σ1,spost)       (XPerson1 .boss@pre .boss@pre   null)"
Assert "    spost.   (σ1,spost)  not(υ(XPerson1 .boss@pre .boss@pre .boss@pre))"

lemma "               (σ1,σ1')       (XPerson1 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def
             σ1_def σ1'_def
             XPerson1_def person1_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
             oid_of_option_def oid_of_typePerson_def)

lemma "spre spost.   (spre,spost)     ((XPerson1 .oclAsType(OclAny) .oclAsType(Person))  XPerson1)"
by(rule up_down_cast_Person_OclAny_Person', simp add: XPerson1_def)
Assert "spre spost.   (spre,spost)      (XPerson1 .oclIsTypeOf(Person))"
Assert "spre spost.   (spre,spost)   not(XPerson1 .oclIsTypeOf(OclAny))"
Assert "spre spost.   (spre,spost)      (XPerson1 .oclIsKindOf(Person))"
Assert "spre spost.   (spre,spost)      (XPerson1 .oclIsKindOf(OclAny))"
Assert "spre spost.   (spre,spost)   not(XPerson1 .oclAsType(OclAny) .oclIsTypeOf(OclAny))"


Assert "spre     .   (spre,σ1')       (XPerson2 .salary        𝟭𝟴𝟬𝟬)"
Assert "    spost.   (σ1,spost)       (XPerson2 .salary@pre    𝟭𝟮𝟬𝟬)"
Assert "spre     .   (spre,σ1')       (XPerson2 .boss       XPerson2)"
Assert "               (σ1,σ1')       (XPerson2 .boss .salary@pre       𝟭𝟮𝟬𝟬)"
Assert "               (σ1,σ1')       (XPerson2 .boss .boss@pre       null)"
Assert "    spost.   (σ1,spost)       (XPerson2 .boss@pre   null)"
Assert "    spost.   (σ1,spost)       (XPerson2 .boss@pre  <> XPerson2)"
Assert "               (σ1,σ1')       (XPerson2 .boss@pre  <> (XPerson2 .boss))"
Assert "    spost.   (σ1,spost)  not(υ(XPerson2 .boss@pre .boss))"
Assert "    spost.   (σ1,spost)  not(υ(XPerson2 .boss@pre .salary@pre))"
lemma "               (σ1,σ1')       (XPerson2 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ1_def σ1'_def XPerson2_def person2_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
             oid_of_option_def oid_of_typePerson_def)

Assert "spre     .   (spre,σ1')       (XPerson3 .salary        null)"
Assert "    spost.   (σ1,spost)  not(υ(XPerson3 .salary@pre))"
Assert "spre     .   (spre,σ1')       (XPerson3 .boss        null)"
Assert "spre     .   (spre,σ1')  not(υ(XPerson3 .boss .salary))"
Assert "    spost.   (σ1,spost)  not(υ(XPerson3 .boss@pre))"
lemma "               (σ1,σ1')       (XPerson3 .oclIsNew())"
by(simp add: OclValid_def OclIsNew_def σ1_def σ1'_def XPerson3_def person3_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
             oid_of_option_def oid_of_typePerson_def)


Assert "    spost.   (σ1,spost)       (XPerson4 .boss@pre    XPerson5)"
Assert "               (σ1,σ1')  not(υ(XPerson4 .boss@pre .salary))"
Assert "    spost.   (σ1,spost)       (XPerson4 .boss@pre .salary@pre    𝟯𝟱𝟬𝟬)"
lemma "               (σ1,σ1')       (XPerson4 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ1_def σ1'_def XPerson4_def person4_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
             oid_of_option_def oid_of_typePerson_def)

Assert "spre     .   (spre,σ1')  not(υ(XPerson5 .salary))"
Assert "    spost.   (σ1,spost)       (XPerson5 .salary@pre    𝟯𝟱𝟬𝟬)"
Assert "spre     .   (spre,σ1')  not(υ(XPerson5 .boss))"
lemma "               (σ1,σ1')       (XPerson5 .oclIsDeleted())"
by(simp add: OclNot_def OclValid_def OclIsDeleted_def σ1_def σ1'_def XPerson5_def person5_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
             oid_of_option_def oid_of_typePerson_def)

(* (* access to an oclany object not yet supported *) Assert "  (σ11') ⊨     ((XPerson6 .boss .salary)   ≐ 𝟯𝟮𝟬𝟬 )"*)
Assert "spre     .   (spre,σ1')  not(υ(XPerson6 .boss .salary@pre))"
Assert "    spost.   (σ1,spost)       (XPerson6 .boss@pre    XPerson4)"
Assert "               (σ1,σ1')       (XPerson6 .boss@pre .salary    𝟮𝟵𝟬𝟬)"
Assert "    spost.   (σ1,spost)       (XPerson6 .boss@pre .salary@pre    𝟮𝟲𝟬𝟬)"
Assert "    spost.   (σ1,spost)       (XPerson6 .boss@pre .boss@pre   XPerson5)"
lemma "               (σ1,σ1')       (XPerson6 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ1_def σ1'_def XPerson6_def person6_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
             oid_of_option_def oid_of_typePerson_def)

(* (* access to an oclany object not yet supported *) Assert "  (σ11') ⊨     ((XPerson7 .oclAsType(Person)   ≐  (XPerson6 .boss)))" *)
(* (* access to an oclany object not yet supported *) Assert "  (σ11') ⊨     ((XPerson7 .oclAsType(Person) .boss)   ≐ (XPerson7 .oclAsType(Person)) )" *)
(* (* access to an oclany object not yet supported *) Assert "  (σ11') ⊨     ((XPerson7 .oclAsType(Person) .boss .salary)   ≐ 𝟯𝟮𝟬𝟬 )" *)
Assert "spre spost.   (spre,spost)      υ(XPerson7 .oclAsType(Person))"
Assert "    spost.    (σ1,spost)  not(υ(XPerson7 .oclAsType(Person) .boss@pre))"
lemma "spre spost.   (spre,spost)      ((XPerson7 .oclAsType(Person) .oclAsType(OclAny)
                                                                   .oclAsType(Person))
                                       (XPerson7 .oclAsType(Person)))"
by(rule up_down_cast_Person_OclAny_Person', simp add: XPerson7_def OclValid_def valid_def person7_def)
lemma "               (σ1,σ1')        (XPerson7 .oclIsNew())"
by(simp add: OclValid_def OclIsNew_def  σ1_def σ1'_def  XPerson7_def person7_def
             oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
             oid_of_option_def oid_of_typeOclAny_def)

Assert "spre spost.   (spre,spost)       (XPerson8  <> XPerson7)"
Assert "spre spost.   (spre,spost)  not(υ(XPerson8 .oclAsType(Person)))"
Assert "spre spost.   (spre,spost)       (XPerson8 .oclIsTypeOf(OclAny))"
Assert "spre spost.   (spre,spost)    not(XPerson8 .oclIsTypeOf(Person))"
Assert "spre spost.   (spre,spost)    not(XPerson8 .oclIsKindOf(Person))"
Assert "spre spost.   (spre,spost)       (XPerson8 .oclIsKindOf(OclAny))"

lemma σ_modifiedonly: "(σ1,σ1')  (Set{ XPerson1 .oclAsType(OclAny)
                      , XPerson2 .oclAsType(OclAny)
                      ⌦‹, XPerson3 .oclAsType(OclAny)›
                      , XPerson4 .oclAsType(OclAny)
                      ⌦‹, XPerson5 .oclAsType(OclAny)›
                      , XPerson6 .oclAsType(OclAny)
                      ⌦‹, XPerson7 .oclAsType(OclAny)›
                      ⌦‹, XPerson8 .oclAsType(OclAny)›
                      ⌦‹, XPerson9 .oclAsType(OclAny)›}->oclIsModifiedOnly())"
 apply(simp add: OclIsModifiedOnly_def OclValid_def
                 oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                 XPerson1_def XPerson2_def XPerson3_def XPerson4_def
                 XPerson5_def XPerson6_def XPerson7_def XPerson8_def XPerson9_def
                 person1_def person2_def person3_def person4_def
                 person5_def person6_def person7_def person8_def person9_def
                 image_def)
 apply(simp add: OclIncluding_rep_set mtSet_rep_set null_option_def bot_option_def)
 apply(simp add: oid_of_option_def oid_of_typeOclAny_def, clarsimp)
 apply(simp add: σ1_def σ1'_def
                 oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
done

lemma "(σ1,σ1')  ((XPerson9 @pre (λx. OclAsTypePerson_𝔄 x))   XPerson9)"
by(simp add: OclSelf_at_pre_def σ1_def oid_of_option_def oid_of_typePerson_def
             XPerson9_def person9_def oid8_def OclValid_def StrongEq_def OclAsTypePerson_𝔄_def)

lemma "(σ1,σ1')  ((XPerson9 @post (λx. OclAsTypePerson_𝔄 x))   XPerson9)"
by(simp add: OclSelf_at_post_def σ1'_def oid_of_option_def oid_of_typePerson_def
             XPerson9_def person9_def oid8_def OclValid_def StrongEq_def OclAsTypePerson_𝔄_def)

lemma "(σ1,σ1')  (((XPerson9 .oclAsType(OclAny)) @pre (λx. OclAsTypeOclAny_𝔄 x)) 
                   ((XPerson9 .oclAsType(OclAny)) @post (λx. OclAsTypeOclAny_𝔄 x)))"
proof -

 have including4 : "a b c d τ.
        Set{λτ. a, λτ. b, λτ. c, λτ. d} τ = Abs_Setbase  {a, b, c, d} "
  apply(subst abs_rep_simp'[symmetric], simp)
  apply(simp add: OclIncluding_rep_set mtSet_rep_set)
  by(rule arg_cong[of _ _ "λx. (Abs_Setbase( x ))"], auto)

 have excluding1: "S a b c d e τ.
                   (λ_. Abs_Setbase  {a, b, c, d} )->excludingSet(λτ. e) τ =
                   Abs_Setbase  {a, b, c, d} - {e} "
  apply(simp add: UML_Set.OclExcluding_def)
  apply(simp add: defined_def OclValid_def false_def true_def
                  bot_fun_def bot_Setbase_def null_fun_def null_Setbase_def)
  apply(rule conjI)
   apply(rule impI, subst (asm) Abs_Setbase_inject) apply( simp add: bot_option_def)+
  apply(rule conjI)
   apply(rule impI, subst (asm) Abs_Setbase_inject) apply( simp add: bot_option_def null_option_def)+
  apply(subst Abs_Setbase_inverse, simp add: bot_option_def, simp)
 done

 show ?thesis
  apply(rule framing[where X = "Set{ XPerson1 .oclAsType(OclAny)
                       , XPerson2 .oclAsType(OclAny)
                       ⌦‹, XPerson3 .oclAsType(OclAny)›
                       , XPerson4 .oclAsType(OclAny)
                       ⌦‹, XPerson5 .oclAsType(OclAny)›
                       , XPerson6 .oclAsType(OclAny)
                       ⌦‹, XPerson7 .oclAsType(OclAny)›
                       ⌦‹, XPerson8 .oclAsType(OclAny)›
                       ⌦‹, XPerson9 .oclAsType(OclAny)›}"])
   apply(cut_tac σ_modifiedonly)
   apply(simp only: OclValid_def
                    XPerson1_def XPerson2_def XPerson3_def XPerson4_def
                    XPerson5_def XPerson6_def XPerson7_def XPerson8_def XPerson9_def
                    person1_def person2_def person3_def person4_def
                    person5_def person6_def person7_def person8_def person9_def
                    OclAsTypeOclAny_Person)
   apply(subst cp_OclIsModifiedOnly, subst UML_Set.OclExcluding.cp0,
     subst (asm) cp_OclIsModifiedOnly, simp add: including4 excluding1)

  apply(simp only: XPerson1_def XPerson2_def XPerson3_def XPerson4_def
                   XPerson5_def XPerson6_def XPerson7_def XPerson8_def XPerson9_def
                   person1_def person2_def person3_def person4_def
                   person5_def person6_def person7_def person8_def person9_def)
  apply(simp add: OclIncluding_rep_set mtSet_rep_set
                  oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
  apply(simp add: StrictRefEqObject_def oid_of_option_def oid_of_typeOclAny_def OclNot_def OclValid_def
                  null_option_def bot_option_def)
 done
qed

lemma perm_σ1' : 1' =  heap = Map.empty
                           (oid8  inPerson person9)
                           (oid7  inOclAny person8)
                           (oid6  inOclAny person7)
                           (oid5  inPerson person6)
                           ⌦‹oid4›
                           (oid3  inPerson person4)
                           (oid2  inPerson person3)
                           (oid1  inPerson person2)
                           (oid0  inPerson person1)
                       , assocs = assocs σ1' "
proof -
 note P = fun_upd_twist
 show ?thesis
  apply(simp add: σ1'_def
                  oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
  apply(subst (1) P, simp)
  apply(subst (2) P, simp) apply(subst (1) P, simp)
  apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
  apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
  apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
  apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
  apply(subst (7) P, simp) apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
 by(simp)
qed

declare const_ss [simp]

lemma "σ1.
 (σ1,σ1')  (Person .allInstances()  Set{ XPerson1, XPerson2, XPerson3, XPerson4⌦‹, XPerson5›, XPerson6,
                                           XPerson7 .oclAsType(Person)⌦‹, XPerson8›, XPerson9 })"
 apply(subst perm_σ1')
 apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                  XPerson1_def XPerson2_def XPerson3_def XPerson4_def
                  XPerson5_def XPerson6_def XPerson7_def XPerson8_def XPerson9_def
                  person7_def)
 apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
  apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
   apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
    apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
     apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
      apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
       apply(subst state_update_vs_allInstances_at_post_ntc, simp, simp add: OclAsTypePerson_𝔄_def
                                                                             person8_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp)
       apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypePerson_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
        apply(rule state_update_vs_allInstances_at_post_empty)
by(simp_all add: OclAsTypePerson_𝔄_def)

lemma "σ1.
 (σ1,σ1')  (OclAny .allInstances()  Set{ XPerson1 .oclAsType(OclAny), XPerson2 .oclAsType(OclAny),
                                           XPerson3 .oclAsType(OclAny), XPerson4 .oclAsType(OclAny)
                                           ⌦‹, XPerson5›, XPerson6 .oclAsType(OclAny),
                                           XPerson7, XPerson8, XPerson9 .oclAsType(OclAny) })"
 apply(subst perm_σ1')
 apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                  XPerson1_def XPerson2_def XPerson3_def XPerson4_def XPerson5_def XPerson6_def XPerson7_def XPerson8_def XPerson9_def
                  person1_def person2_def person3_def person4_def person5_def person6_def person9_def)
 apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsTypeOclAny_𝔄_def, simp, rule const_StrictRefEqSet_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)+
         apply(rule state_update_vs_allInstances_at_post_empty)
by(simp_all add: OclAsTypeOclAny_𝔄_def)

end

Theory Design_OCL

(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * Design_OCL.thy --- OCL Contracts and an Example.
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

theory
  Design_OCL
imports
  Design_UML
begin
text ‹\label{ex:employee-design:ocl}›

section‹OCL Part: Invariant›
text‹These recursive predicates can be defined conservatively
by greatest fix-point
constructions---automatically. See~\cite{brucker.ea:hol-ocl-book:2006,brucker:interactive:2007}
for details. For the purpose of this example, we state them as axioms
here.

\begin{ocl}
context Person
  inv label : self .boss <> null implies (self .salary  ≤  ((self .boss) .salary))
\end{ocl}
›

definition Person_labelinv :: "Person  Boolean" 
where     "Person_labelinv (self)   
                 (self .boss <> null implies (self .salary  int  ((self .boss) .salary)))"
                                       

definition Person_labelinvATpre :: "Person  Boolean" 
where     "Person_labelinvATpre (self)   
                 (self .boss@pre <> null implies (self .salary@pre int ((self .boss@pre) .salary@pre)))"

definition Person_labelglobalinv :: "Boolean"
where     "Person_labelglobalinv  (Person .allInstances()->forAllSet(x | Person_labelinv (x)) and 
                                  (Person .allInstances@pre()->forAllSet(x | Person_labelinvATpre (x))))"
                                  
                                  
lemma "τ  δ (X .boss)  τ  Person .allInstances()->includesSet(X .boss) 
                            τ  Person .allInstances()->includesSet(X) "
oops  
(* To be generated generically ... hard, but crucial lemma that should hold. 
   It means that X and it successor are object representation that actually
   occur in the state. *)

lemma REC_pre : "τ  Person_labelglobalinv 
        τ  Person .allInstances()->includesSet(X) ― ‹X› represented object in state›
         REC.  τ  REC(X)   (Person_labelinv (X) and (X .boss <> null implies REC(X .boss)))"
oops (* Attempt to allegiate the burden of he following axiomatizations: could be
        a witness for a constant specification ...*)       

text‹This allows to state a predicate:›
                                       
axiomatization invPerson_label :: "Person  Boolean"
where invPerson_label_def:
"(τ  Person .allInstances()->includesSet(self))  
 (τ  (invPerson_label(self)   (self .boss <> null implies  
                                  (self .salary  int  ((self .boss) .salary)) and
                                   invPerson_label(self .boss))))"

axiomatization invPerson_labelATpre :: "Person  Boolean"
where invPerson_labelATpre_def: 
"(τ  Person .allInstances@pre()->includesSet(self)) 
 (τ  (invPerson_labelATpre(self)  (self .boss@pre <> null implies 
                                   (self .salary@pre  int  ((self .boss@pre) .salary@pre)) and
                                    invPerson_labelATpre(self .boss@pre))))"


lemma inv_1 : 
"(τ  Person .allInstances()->includesSet(self)) 
    (τ  invPerson_label(self) = ((τ  (self .boss  null)) 
                               ( τ  (self .boss <> null)  
                                 τ  ((self .salary)  int  (self .boss .salary))  
                                 τ  (invPerson_label(self .boss))))) "
oops (* Let's hope that this holds ... *)


lemma inv_2 : 
"(τ  Person .allInstances@pre()->includesSet(self)) 
    (τ  invPerson_labelATpre(self)) =  ((τ  (self .boss@pre  null)) 
                                     (τ  (self .boss@pre <> null) 
                                     (τ  (self .boss@pre .salary@pre int self .salary@pre))  
                                     (τ  (invPerson_labelATpre(self .boss@pre)))))"
oops (* Let's hope that this holds ... *)

text‹A very first attempt to characterize the axiomatization by an inductive
definition - this can not be the last word since too weak (should be equality!)›
coinductive inv :: "Person  (𝔄)st  bool" where
 "(τ  (δ self))  ((τ  (self .boss  null)) 
                      (τ  (self .boss <> null)  (τ  (self .boss .salary int self .salary))  
                     ( (inv(self .boss))τ )))
                      ( inv self τ)"


section‹OCL Part: The Contract of a Recursive Query›
text‹This part is analogous to the Analysis Model and skipped here.›


end